34
35:- module(file_uploader, []). 36:- use_module(library(http/http_path)). 37:- use_module(library(http/http_dispatch)). 38:- use_module(library(http/http_header)). 39:- use_module(library(http/http_multipart_plugin)). 40:- use_module(library(http/http_client)). 41:- use_module(library(http/http_json)). 42:- use_module(library(filesex)). 43:- use_module(library(option)). 44:- use_module(library(settings)). 45:- use_module(library(debug)). 46:- use_module(library(broadcast)). 47
77:- setting(upload_directory, atom, uploads,
78 "Directory for storing uploaded files"). 79:- setting(upload_size_limit, nonneg, 100 000 000,
80 "Max size for an uploaded file"). 81
82http:location(fine, root(fine), []).
83
84:- http_handler(fine(uploads), fine_uploads,
85 [method(post)]). 86:- http_handler(fine(uploads/finished), fine_upload_finished,
87 [method(post)]). 88:- http_handler(fine('uploads/delete/'), fine_upload_delete,
89 [method(delete), prefix]). 90
91
92
106fine_uploads(Request) :-
107 is_multipart_post_request(Request),
108 catch(( http_read_data(Request, Parts,
109 [ on_filename(save_file(Request, Parts))
110 ]),
111 memberchk(qqfile=file(FileName, Saved), Parts),
112 debug(upload, 'Saved ~p in ~p', [FileName, Saved])
113 ), E, true),
114 !,
115 ( var(E)
116 -> reply_json_dict(json{success: true})
117 ; message_to_string(E, Msg),
118 reply_json_dict(json{error: Msg})
119 ).
120fine_uploads(_Request) :-
121 reply_json_dict(json{error: "Bad file upload request"}).
122
123is_multipart_post_request(Request) :-
124 memberchk(method(post), Request),
125 memberchk(content_type(ContentType), Request),
126 http_parse_header_value(
127 content_type, ContentType,
128 media(multipart/'form-data', _)).
129
130:- public save_file/5. 131
132save_file(Request, Parts0, In, file(FileName, Path), Options) :-
133 copy_term(Parts0, Parts),
134 once(append(Parts, [], _)), 135 debug(upload, 'Params so far: ~p', [Parts]),
136 ( option(filename(FileName), Options),
137 FileName \== blob
138 -> true
139 ; part(qqfilename, Parts, FileName)
140 ),
141 file_name_extension(_, Ext, FileName),
142 part(qquuid, Parts, UUID),
143 upload_file(UUID, Ext, Dir, Path),
144 enforce_file_size_limit(Parts, FileName, Size),
145 part_offset(Parts, Size, IsMulti, Offset),
146 debug(upload, 'IsMulti = ~p, Offset = ~p', [IsMulti, Offset]),
147 make_directory_path(Dir),
148 setup_call_cleanup(
149 open(Path, update, Out,
150 [ type(binary)
151 ]),
152 ( seek(Out, Offset, bof, NewOffset),
153 assertion(Offset == NewOffset),
154 copy_stream_data(In, Out)
155 ),
156 close(Out)),
157 ( IsMulti == false
158 -> broadcast(file_upload(FileName, Path, Request))
159 ; true
160 ).
161
162enforce_file_size_limit(Parts, FileName, Size) :-
163 part(qqtotalfilesize, Parts, Size),
164 setting(upload_size_limit, Limit),
165 ( Size =< Limit
166 -> true
167 ; permission_error(upload, file, FileName)
168 ).
169
170part_offset(Parts, Size, true, Offset) :-
171 part(qqpartbyteoffset, Parts, Offset),
172 ( Offset =< Size
173 -> true
174 ; permission_error(offset, file, Offset)
175 ),
176 !.
177part_offset(_, _, false, 0).
178
179part(Name, Parts, Value) :-
180 memberchk(Name=V0, Parts),
181 ( atom_number(V0, Value)
182 -> true
183 ; Value = V0
184 ).
190fine_upload_finished(Request) :-
191 http_read_json_dict(Request, Parts),
192 debug(upload, 'Finished params: ~p', [Parts]),
193 upload_file(Parts.qquuid, _Ext, _Dir, SavedFile),
194 broadcast(file_upload(Parts.qqfilename, SavedFile, Request)),
195 reply_json_dict(json{success: true}).
196
197upload_file(UUID, Ext, Dir, Path) :-
198 nonvar(Ext),
199 !,
200 setting(upload_directory, Dir),
201 file_name_extension(UUID, Ext, File),
202 directory_file_path(Dir, File, Path).
203upload_file(UUID, Ext, Dir, Path) :-
204 atom_concat(UUID, '.*', FilePattern),
205 setting(upload_directory, Dir),
206 directory_file_path(Dir, FilePattern, Pattern),
207 expand_file_name(Pattern, [Path]),
208 file_name_extension(_, Ext, Path).
215fine_upload_delete(Request) :-
216 option(path_info(UUID), Request),
217 upload_file(UUID, _Ext, _Dir, Path),
218 delete_file(Path),
219 reply_json_dict(json{success: true}).
220
221
222 225
226:- multifile prolog:message//1. 227
228prolog:message(bad_file_upload) -->
229 [ 'A file upload must be submitted as multipart/form-data using', nl,
230 'name=file and providing a file-name'
231 ]
Fine uploader HTTP backend
This module implements the traditional HTTP backend methods to use Fine Uploader, a modern and feature-rich web client for uploading files to an HTTP server. The upload backend implements the following features:
Files that are received are placed in a directory controlled by the setting
upload_directory, which defaults touploads. If the directory does not exsit but can be created this is done.Integration with the remainder of the server is accomplished using the library(broadcast). This library broadcasts the following events:
upload_directoryand has the same extension as the original file. Request may be used to identify the user. This hook is executed in the context of the receiving HTTP worker.