1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (c)  2018, VU University Amsterdam
    7    All rights reserved.
    8
    9    Redistribution and use in source and binary forms, with or without
   10    modification, are permitted provided that the following conditions
   11    are met:
   12
   13    1. Redistributions of source code must retain the above copyright
   14       notice, this list of conditions and the following disclaimer.
   15
   16    2. Redistributions in binary form must reproduce the above copyright
   17       notice, this list of conditions and the following disclaimer in
   18       the documentation and/or other materials provided with the
   19       distribution.
   20
   21    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   22    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   23    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   24    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   25    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   26    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   27    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   28    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   29    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   30    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   31    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   32    POSSIBILITY OF SUCH DAMAGE.
   33*/
   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
   48% :- debug(upload).

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 to uploads. 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:

file_upload(+Name, +SavedFile, +Request)
A file named Name has been uploaded to SavedFile. SavedFile is an absolute path to the file saved in the directory defined by the setting upload_directory and 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.
See also
- https://docs.fineuploader.com/endpoint_handlers/traditional.html */
   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		 /*******************************
   93		 *          HTTP METHODS	*
   94		 *******************************/
 fine_uploads(+Request)
Handle a Fine Uploader upload request. This currently deals with both one-shot and chunked uploading. If an upload is completed the system will broadcast the following message:
file_upload(Name, SavedFile, Request)
See also
- https://docs.fineuploader.com/endpoint_handlers/traditional.html
  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, [], _)),                 % close the list
  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    ).
 fine_upload_finished(+Request)
Called after all parts for a file are transferred
  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).
 fine_upload_delete(+Request)
Handle a DELETE request. The argument is a UUID that should only be known to the client, so this should be safe.
  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		 /*******************************
  223		 *            MESSAGES		*
  224		 *******************************/
  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    ]