1:- module(tus, [set_tus_options/1,          % +Options
    2                % server
    3                tus_dispatch/1,             % +Request
    4                tus_dispatch/2,             % +Options, +Request
    5                tus_dispatch/3,             % +Method, +Options, +Request
    6
    7                % client
    8                tus_options/3,              % +Endpoint_URI, -Tus_Options, +Options
    9
   10                tus_upload/3,               % +File, +Endpoint_URI, -Resource_URI
   11                tus_upload/4,               % +File, +Endpoint_URI, -Resource_URI,
   12                                            %   +Options
   13                tus_resume/3,               % +File, +Endpoint_URI, ?Resource_URI
   14                tus_resume/4,               % +File, +Endpoint_URI, ?Resource_URI,
   15                                            %   +Options
   16                tus_delete/3,               % +Resource_URI, +TUS_Options, +Options
   17
   18                tus_uri_resource/2,         % +URI, -Resource
   19
   20                tus_resource_path/3         % +Resource, -Path, +Options
   21               ]).

TUS Protocol

Both client and server implementation of the TUS protocol.

The TUS protocol allows resumable file uploads via HTTP in swipl https://tus.io/

Server implementation

Requests are structured according to the prolog http library format.

Implemented features of the TUS protocol:

OPTIONS (Discovery) POST (Create)* HEAD (Find resumption point) PATCH (Send chunk)

Suggested

*/

   45:- use_module(library(http/http_client)).   46:- use_module(library(http/http_header)).   47:- use_module(library(http/thread_httpd)).   48
   49/* parsing tools */
   50:- use_module(tus/parse).   51:- use_module(tus/utilities).   52
   53:- use_module(library(apply)).   54:- use_module(library(crypto)).   55:- use_module(library(debug)).   56:- use_module(library(error)).   57:- use_module(library(lists)).   58:- use_module(library(option)).   59:- use_module(library(readutil)).   60:- use_module(library(md5)).   61:- use_module(library(when)).   62:- use_module(library(yall)).   63
   64:- use_module(library(plunit)).   65
   66/* Options */
   67:- meta_predicate valid_options(+, 1).   68valid_options(Options, Pred) :-
   69    must_be(list, Options),
   70    verify_options(Options, Pred).
   71
   72verify_options([], _).
   73verify_options([H|T], Pred) :-
   74    (   call(Pred, H)
   75    ->  verify_options(T, Pred)
   76    ;   throw(error(domain_error(Pred, H), _))
   77    ).
 set_tus_options(+Options) is det
Sets the global options for the tus server and client.
Arguments:
Options- Includes the following options:
  • tus_storage_path(Path): Location of server storage folder.
  • tus_max_size(Size): Maximum chunk size accepted by the server.
  • tus_client_chunk_size(Size)): Size of chunks to be sent to the server.
  • tus_expiry(Expires): Expires after Expires seconds.

/

   90set_tus_options(Options) :-
   91    retract_tus_dynamics,
   92    valid_options(Options, global_tus_option),
   93    create_prolog_flag(tus_options, Options, []).
   94
   95global_tus_option(tus_storage_path(_Path)).
   96global_tus_option(tus_max_size(Size)) :-
   97    must_be(positive_integer, Size).
   98global_tus_option(tus_client_chunk_size(Size)) :-
   99    must_be(positive_integer, Size).
  100global_tus_option(tus_expiry_seconds(Seconds)) :-
  101    must_be(positive_integer, Seconds).
  102
  103tus_default_options(
  104    [
  105        tus_max_size(17_179_869_184),
  106        tus_client_chunk_size(16_777_216),
  107        tus_expiry_seconds(86400),
  108        tus_storage_path(_Dummy)
  109    ]
  110).
  111
  112tus_merged_options(Options) :-
  113    tus_default_options(Defaults),
  114    (   current_prolog_flag(tus_options, User)
  115    ->  true
  116    ;   User = []),
  117    merge_options(User, Defaults, Options).
  118
  119get_tus_option(Option) :-
  120    tus_merged_options(Options),
  121    option(Option, Options).
  122
  123:- dynamic tus_storage_path_dynamic/1.  124
  125retract_tus_dynamics :-
  126    retractall(tus_storage_path_dynamic(_)).
  127
  128/* Tus server constants */
  129tus_version_list('1.0.0').
  130
  131tus_max_size(Size) :-
  132    get_tus_option(tus_max_size(Size)).
  133
  134tus_client_chunk_size(Size) :-
  135    get_tus_option(tus_client_chunk_size(Size)).
  136
  137tus_expiry_seconds(Seconds) :-
  138    get_tus_option(tus_expiry_seconds(Seconds)).
  139
  140tus_extension(creation).
  141tus_extension(expiration).
  142tus_extension(checksum).
  143tus_extension(termination).
  144
  145tus_extension_list(Atom) :-
  146    findall(Extension,
  147            tus_extension(Extension),
  148            Extensions),
  149    atomic_list_concat(Extensions, ',', Atom).
  150
  151% In precedence order
  152tus_checksum_algorithm(sha1).
  153tus_checksum_algorithm(md5).
  154
  155tus_checksum_algorithm_list(Atom) :-
  156    findall(Extension,
  157            tus_checksum_algorithm(Extension),
  158            Extensions),
  159    atomic_list_concat(Extensions, ',', Atom).
  160
  161tus_storage_path(Path, Options) :-
  162    memberchk(tus_storage_path(Pre_Path), Options),
  163    terminal_slash(Pre_Path, Path),
  164    !.
  165tus_storage_path(Path, _Options) :-
  166    tus_storage_path_dynamic(Path),
  167    !.
  168tus_storage_path(Path, _Options) :-
  169    current_prolog_flag(tus_options, Options),
  170    memberchk(tus_storage_path(Pre_Path), Options),
  171    terminal_slash(Pre_Path, Path),
  172    assertz(tus_storage_path_dynamic(Path)),
  173    !.
  174tus_storage_path(Temp, _Options) :-
  175    random_file('tus_storage', Temp_File),
  176    make_directory(Temp_File),
  177    terminal_slash(Temp_File,Temp),
  178    assertz(tus_storage_path_dynamic(Temp)).
  179
  180accept_tus_version(Version) :-
  181    member(Version, ['1.0.0']).
  182
  183expiration_timestamp(Expiry) :-
  184    get_time(Time),
  185    tus_expiry_seconds(Seconds),
  186    Expiry is Time + Seconds.
  187
  188algorithm_checksum_string(md5, Checksum, String) :-
  189    md5_hash(String, Checksum, []).
  190algorithm_checksum_string(sha1, Checksum, String) :-
  191    crypto_data_hash(String, Checksum_Pre, [algorithm(sha1),
  192                                            encoding(octet)]),
  193    Checksum_Pre = Checksum.
  194
  195algorithm_checksum_string_value(Algorithm, Checksum, String, Value) :-
  196    when(
  197        (   ground(Algorithm),
  198            ground(Checksum)
  199        ;   ground(Value)),
  200        atomic_list_concat([Algorithm, Checksum], ' ', Value)
  201    ),
  202    algorithm_checksum_string(Algorithm, Checksum, String).
 tus_checksum(+Upload_Checksum, +String)
 /
  207tus_checksum(Upload_Checksum,String) :-
  208    algorithm_checksum_string_value(_Algorithm, _Checksum, String, Upload_Checksum).
  209
  210tus_algorithm_supported(Upload_Checksum) :-
  211    atomic_list_concat([Algorithm, _], ' ', Upload_Checksum),
  212    tus_checksum_algorithm(Algorithm).
  213
  214tus_generate_checksum_header(String, Header, Tus_Options) :-
  215    memberchk(tus_checksum_algorithm(Algorithms), Tus_Options),
  216    tus_checksum_algorithm(Algorithm), % in this order of precedence
  217    member(Algorithm, Algorithms),
  218    !,
  219    algorithm_checksum_string_value(Algorithm, _, String, Upload_Checksum),
  220    Header = [request_header('Upload-Checksum'=Upload_Checksum)].
  221tus_generate_checksum_header(_, Header, _) :-
  222    Header = [].
  223
  224% Should probably also be an option.
  225tus_max_retries(3).
  226
  227check_tus_creation(Tus_Options) :-
  228    memberchk(tus_extension(Extensions), Tus_Options),
  229    memberchk(creation, Extensions).
  230
  231check_tus_termination(Tus_Options) :-
  232    memberchk(tus_extension(Extensions), Tus_Options),
  233    memberchk(termination, Extensions).
  234
  235/*
  236File store manipulation utilities.
  237*/
  238tus_resource_name(File, Name) :-
  239    md5_hash(File, Name, []).
  240
  241tus_resource_base_path(Resource, Path, Options) :-
  242    tus_storage_path(Storage, Options),
  243    option(domain(Domain),Options,'xanadu'),
  244    atomic_list_concat([Storage, Domain, '.', Resource], Path).
  245
  246tus_resource_suffix('completed').
 tus_resource_path(+Resource, -Path, +Options) is det
(Server) Return a fully qualified path for the given resource (assuming fully uploaded).
Arguments:
Resource- The resource which is referenced
Path- The file path location of the associated resource
Options- A list which includes:
  • domain(Domain): The domain in which to store the file (to avoid collisions)

/

  260tus_resource_path(Resource, Path, Options) :-
  261    tus_resource_base_path(Resource, Base_Path, Options),
  262    tus_resource_suffix(Completed),
  263    atomic_list_concat([Base_Path, '/',Completed], Path).
  264
  265tus_resource_deleted_path(Resource, Deleted_Path, Options) :-
  266    tus_resource_base_path(Resource, Path, Options),
  267    atomic_list_concat([Path, '.deleted'], Deleted_Path).
  268
  269tus_offset_suffix('offset').
  270
  271tus_offset_path(Resource, Path, Options) :-
  272    tus_resource_base_path(Resource, RPath, Options),
  273    tus_offset_suffix(Offset),
  274    atomic_list_concat([RPath, '/', Offset], Path).
  275
  276tus_size_suffix('size').
  277
  278tus_size_path(Resource, Path, Options) :-
  279    tus_resource_base_path(Resource, RPath, Options),
  280    tus_size_suffix(Size),
  281    atomic_list_concat([RPath, '/', Size], Path).
  282
  283tus_upload_suffix('upload').
  284
  285tus_upload_path(Resource, Path, Options) :-
  286    tus_resource_base_path(Resource, RPath, Options),
  287    tus_upload_suffix(Upload),
  288    atomic_list_concat([RPath, '/', Upload], Path).
  289
  290tus_lock_suffix('lock').
  291
  292tus_lock_path(Resource, Path, Options) :-
  293    tus_resource_base_path(Resource, RPath, Options),
  294    tus_lock_suffix(Lock),
  295    atomic_list_concat([RPath, '/', Lock], Path).
  296
  297tus_expiry_suffix('expiry').
  298
  299tus_expiry_path(Resource, Path, Options) :-
  300    tus_resource_base_path(Resource, RPath, Options),
  301    tus_expiry_suffix(Offset),
  302    atomic_list_concat([RPath, '/', Offset], Path).
  303
  304tus_metadata_suffix('metadata').
  305
  306tus_metadata_path(Resource, Path, Options) :-
  307    tus_resource_base_path(Resource, RPath, Options),
  308    tus_metadata_suffix(Metadata),
  309    atomic_list_concat([RPath, '/', Metadata], Path).
  310
  311
  312% turns exception into failure.
  313try_make_directory(Directory) :-
  314    catch(
  315        make_directory(Directory),
  316        error(existence_error(directory,_),_),
  317        fail).
  318
  319:- meta_predicate fail_on_missing_file(0).  320fail_on_missing_file(Goal) :-
  321    catch(
  322        call(Goal),
  323        error(existence_error(source_sink,_),_),
  324        fail).
  325
  326path_contents(Offset_File, Offset_String) :-
  327    fail_on_missing_file(
  328        read_file_to_string(Offset_File, Offset_String, [])
  329    ).
  330
  331resource_offset(Resource, Offset, Options) :-
  332    tus_offset_path(Resource, Offset_File, Options),
  333    path_contents(Offset_File, Offset_String),
  334    atom_number(Offset_String, Offset).
  335
  336set_resource_offset(Resource, Offset, Options) :-
  337    setup_call_cleanup(
  338        (   tus_offset_path(Resource, Offset_Path, Options),
  339            open(Offset_Path, write, OP)),
  340        format(OP, "~d", [Offset]),
  341        close(OP)
  342    ).
  343
  344resource_size(Resource, Size, Options) :-
  345    tus_size_path(Resource, Size_File, Options),
  346    path_contents(Size_File, Size_String),
  347    atom_number(Size_String, Size).
  348
  349set_resource_size(Resource, Size, Options) :-
  350    setup_call_cleanup(
  351        (   tus_size_path(Resource, Size_Path, Options),
  352            open(Size_Path, write, SP)),
  353        format(SP, "~d", [Size]),
  354        close(SP)
  355    ).
  356
  357resource_expiry(Resource, Expiry, Options) :-
  358    tus_expiry_path(Resource, Expiry_File, Options),
  359    path_contents(Expiry_File, Expiry_String),
  360    atom_number(Expiry_String, Expiry).
  361
  362set_resource_expiry(Resource, Size, Options) :-
  363    setup_call_cleanup(
  364        (   tus_expiry_path(Resource, Size_Path, Options),
  365            open(Size_Path, write, SP)),
  366        format(SP, "~q", [Size]),
  367        close(SP)
  368    ).
  369
  370resource_metadata(Resource, Metadata, Options) :-
  371    tus_metadata_path(Resource, Metadata_File, Options),
  372    path_contents(Metadata_File, Metadata_String),
  373    read_term_from_atom(Metadata_String, Metadata, []).
  374
  375set_resource_metadata(Resource, Metadata, Options) :-
  376    setup_call_cleanup(
  377        (   tus_metadata_path(Resource, Metadata_Path, Options),
  378            open(Metadata_Path, write, OP)),
  379        format(OP, "~q", [Metadata]),
  380        close(OP)
  381    ).
  382
  383
  384% member(Status, [exists, expires(Expiry)])
  385create_file_resource(Metadata, Size, Name, Status, Options) :-
  386    (   memberchk(filename-File, Metadata)
  387    ->  true
  388    ;   random_string(File)
  389    ),
  390
  391    tus_resource_name(File, Name),
  392    tus_resource_base_path(Name, Path, Options),
  393    (   try_make_directory(Path)
  394    ->  % File
  395        setup_call_cleanup(
  396            (   tus_lock_path(Name, Lock_Path, Options),
  397                open(Lock_Path, write, LP, [lock(exclusive)]) % Get an exclusive lock
  398            ),
  399            setup_call_cleanup(
  400                (   tus_upload_path(Name,File_Path, Options),
  401                    open(File_Path, write, FP)
  402                ),
  403                (   % Size
  404                    set_resource_size(Name, Size, Options),
  405
  406                    % Offset
  407                    set_resource_offset(Name, 0, Options),
  408
  409                    % Expires
  410                    expiration_timestamp(Expiry),
  411                    set_resource_expiry(Name, Expiry, Options),
  412
  413                    % Metadata
  414                    set_resource_metadata(Name, Metadata, Options)
  415                ),
  416                close(FP)
  417            ),
  418            close(LP)
  419        ),
  420        Status=expires(Expiry)
  421    ;   Status=exists
  422    ).
  423
  424patch_resource(Name, Patch, Offset, Length, New_Offset, Options) :-
  425
  426    % sanity check
  427    (   string_length(Patch, Length)
  428    ->  true
  429    ;   throw(error(bad_length(Length)))),
  430
  431    (   resource_offset(Name, Offset, Options)
  432    ->  true
  433    ;   throw(error(bad_offset(Offset)))),
  434
  435    setup_call_cleanup(
  436        (   tus_lock_path(Name, Lock_Path, Options),
  437            open(Lock_Path, write, LP, [lock(exclusive)]) % Get an exclusive lock
  438        ),
  439        (   setup_call_cleanup(
  440                (   tus_upload_path(Name, Upload_Path, Options),
  441                    open(Upload_Path, update, UP, [encoding(octet)])
  442                ),
  443                (   seek(UP, Offset, bof, _),
  444                    format(UP, "~s", [Patch]),
  445                    New_Offset is Offset + Length,
  446
  447                    set_resource_offset(Name, New_Offset, Options)
  448                ),
  449                close(UP)
  450            ),
  451            resource_size(Name, Size, Options),
  452            (   Size = New_Offset
  453            ->  tus_resource_path(Name, Resource_Path, Options),
  454                rename_file(Upload_Path, Resource_Path)
  455            ;   true
  456            )
  457        ),
  458        close(LP)
  459    ).
  460
  461delete_resource(Resource, Options) :-
  462    tus_resource_base_path(Resource, Path, Options),
  463    tus_resource_deleted_path(Resource, Deleted, Options),
  464    rename_file(Path, Deleted),
  465    directory_files(Deleted, All_Files),
  466    exclude([X]>>(member(X,['.', '..'])), All_Files, Files),
  467    forall(
  468        member(File, Files),
  469        (   atomic_list_concat([Deleted, '/', File],Full_Path),
  470            delete_file(Full_Path))),
  471    delete_directory(Deleted).
  472
  473tus_client_effective_chunk_size(Options, Chunk) :-
  474    memberchk(tus_max_size(Max), Options),
  475    tus_client_chunk_size(Size),
  476    Chunk is min(Max,Size).
  477
  478chunk_directive_(Length, Chunk_Size, [Length-0]) :-
  479    Length =< Chunk_Size,
  480    !.
  481chunk_directive_(Length, Chunk_Size, [Chunk_Size-New_Length|Directive]) :-
  482    Length > Chunk_Size,
  483    !,
  484    New_Length is Length - Chunk_Size,
  485    chunk_directive_(New_Length, Chunk_Size, Directive).
  486
  487/*
  488 * Generators for chunk offsets
  489 */
  490chunk_directive(Length, Chunk_Size, Current_Offset, Current_Chunk) :-
  491    chunk_directive(0, Length, Chunk_Size, Current_Offset, Current_Chunk).
  492
  493chunk_directive(Offset, Length, Chunk_Size, Offset, Current_Chunk) :-
  494    Offset < Length,
  495    Current_Chunk is min(Chunk_Size, Length - Offset).
  496chunk_directive(Offset, Length, Chunk_Size, Current_Offset, Current_Chunk) :-
  497    Next_Chunk is min(Chunk_Size, Length - Offset),
  498    Next_Offset is Offset + Next_Chunk,
  499    Next_Offset < Length,
  500    chunk_directive(Next_Offset, Length, Chunk_Size, Current_Offset, Current_Chunk).
 tus_uri_resource(+Uri, -Resource) is det
Return a resource descriptor from the given URI endpoint /
  507tus_uri_resource(URI, Resource) :-
  508    split_string(URI, '/', '', List),
  509    last(List, Resource).
  510
  511terminal_slash(Atom, Slashed) :-
  512    split_string(Atom, '/', '', List),
  513    last(List, Last),
  514    (   Last = ""
  515    ->  Atom = Slashed
  516    ;   atomic_list_concat([Atom, '/'], Slashed)).
  517
  518resumable_endpoint(_, Name, Endpoint, Options) :-
  519    memberchk(resumable_endpoint_base(Pre_Base), Options),
  520    !,
  521    terminal_slash(Pre_Base,Base),
  522    format(atom(Endpoint), "~s~s",[Base,Name]).
  523resumable_endpoint(Request, Name, Endpoint, _Options) :-
  524    memberchk(protocol(Protocol),Request),
  525    memberchk(host(Server),Request),
  526    (   memberchk(port(Port),Request)
  527    ->  true
  528    ;   Port = 80
  529    ),
  530    memberchk(request_uri(Pre_Base),Request),
  531    terminal_slash(Pre_Base,Base),
  532    format(atom(Endpoint), "~s://~s:~d~s~s", [Protocol,Server,Port,Base,Name]).
  533
  534% This is a terrible way to get the output stream...
  535% something is broken - should be set in current_output
  536http_output_stream(Request, Out) :-
  537    memberchk(pool(client(_,_,_,Out)), Request).
  538
  539format_headers(_, []).
  540format_headers(Out, [Term|Rest]) :-
  541    Term =.. [Atom,Value],
  542    format(Out, "~s: ~w~n", [Atom, Value]),
  543    format_headers(Out, Rest).
  544
  545format_custom_response(Out, checksum_mismatch) :-
  546    format(Out, "HTTP/1.1 460 Checksum Mismatch~n",[]).
  547format_custom_response(Out, conflict) :-
  548    format(Out, "HTTP/1.1 409 Conflict~n",[]).
  549format_custom_response(Out, gone) :-
  550    format(Out, "HTTP/1.1 410 Gone~n",[]).
  551
  552custom_status_reply(Custom_Response, Out, Headers) :-
  553    format_custom_response(Out,Custom_Response),
  554    format_headers(Out,Headers),
  555    format(Out,"\r\n",[]).
  556
  557status_code(created,201).
  558status_code(no_content,204).
  559status_code(bad_request,400).
  560status_code(forbidden,403).
  561status_code(not_found,404).
  562status_code(conflict,409).
  563status_code(gone,410).
  564status_code(unsupported_media,415).
  565status_code(bad_checksum,460).
  566
  567/*
  568 * Server dispatch
  569 */
 tus_dispatch(+Options, +Request) is semidet
See tus_dispatch/2

/

  577tus_dispatch(Request) :-
  578    tus_dispatch([],Request).
 tus_dispatch(+Options, +Request) is semidet
Dispatches various TUS requests to the appropriate handlers.

Should be callable from http_handler/3 with something along the lines of:

` http_handler(root(files), tus_dispatch, [ methods([options,head,post,patch]), prefix ]) `
Arguments:
Options- A list with the following flags:
  • domain(Domain): An organisation/domain/user in which to isolate the file
    uploads. This can be used together with authentication. (see tests or README.md)
Request- is the standard Request object from the http_server /
  599tus_dispatch(Options,Request) :-
  600    (   memberchk('X-HTTP-Method-Override'(Method), Request)
  601    ->  true
  602    ;   memberchk(method(Method),Request)),
  603    tus_dispatch(Method,Options,Request).
 tus_dispatch(+Mode, +Request) is semidet
Version of tus_dispatch/1 which includes explicit mode. The tus_dispatch/0 version is to be preferred for proper handling of 'X-HTTP-Method_Override'.
Arguments:
Mode- One of: options, head, post, patch
Request- is the standard Request object from the http_server

/

  616tus_dispatch(options,_Options,Request) :-
  617    % Options
  618    !,
  619    tus_version_list(Version_List),
  620    tus_max_size(Max_Size),
  621    tus_extension_list(Extension_List),
  622    tus_checksum_algorithm_list(Algorithm_List),
  623    http_output_stream(Request, Out),
  624    http_status_reply(no_content, Out,
  625                      ['Tus-Resumable'('1.0.0'),
  626                       'Tus-Version'(Version_List),
  627                       'Tus-Max-Size'(Max_Size),
  628                       'Tus-Checksum-Algorithm'(Algorithm_List),
  629                       'Tus-Extension'(Extension_List)
  630                      ],
  631                      204).
  632tus_dispatch(post,Options,Request) :-
  633    % Create
  634    !,
  635    memberchk(upload_length(Length_Atom),Request),
  636    atom_number(Length_Atom, Length),
  637
  638    memberchk(upload_metadata(Metadata_Atom),Request),
  639    debug(tus, "~q", [Metadata_Atom]),
  640    parse_upload_metadata(Metadata_Atom, Metadata),
  641
  642    memberchk(tus_resumable(Version),Request),
  643    accept_tus_version(Version),
  644
  645    create_file_resource(Metadata, Length, Name, Status, Options),
  646
  647    resumable_endpoint(Request, Name, Endpoint, Options),
  648
  649    http_output_stream(Request, Out),
  650    (   Status = exists
  651    ->  custom_status_reply(conflict, Out,
  652                            ['Tus-Resumable'('1.0.0'),
  653                             'Location'(Endpoint)])
  654    ;   Status = expires(Expiry),
  655        http_timestamp(Expiry, Expiry_Date),
  656        http_status_reply(created(Endpoint), Out,
  657                          ['Tus-Resumable'('1.0.0'),
  658                           'Upload-Expires'(Expiry_Date)],
  659                          _Code2)
  660    ).
  661tus_dispatch(head,Options,Request) :-
  662    % Find position
  663    !,
  664    memberchk(request_uri(URI), Request),
  665    tus_uri_resource(URI, Resource),
  666    http_output_stream(Request, Out),
  667
  668    (   resource_offset(Resource, Offset, Options),
  669        resource_size(Resource, Size, Options)
  670    ->  http_reply(bytes('application/offset+octet-stream',""), Out,
  671                   ['Tus-Resumable'('1.0.0'),
  672                    'Upload-Offset'(Offset),
  673                    'Upload-Length'(Size),
  674                    'Cache-Control'('no-store')])
  675    ;   http_status_reply(not_found(URI), Out,
  676                          ['Tus-Resumable'('1.0.0')],
  677                          _Code)
  678    ).
  679tus_dispatch(patch,Options,Request) :-
  680    % Patch next bit
  681    !,
  682    memberchk(request_uri(URI),Request),
  683    memberchk(content_length(Length),Request),
  684
  685    memberchk(upload_offset(Offset_Atom),Request),
  686    atom_number(Offset_Atom, Offset),
  687
  688    http_read_data(Request, Patch, []),
  689
  690    http_output_stream(Request, Out),
  691    (   memberchk(upload_checksum(Upload_Checksum),Request),
  692        \+ tus_checksum(Upload_Checksum,Patch)
  693    % We have a checksum to check and it doesn't check out.
  694    ->  (   \+ tus_algorithm_supported(Upload_Checksum)
  695        % Because the algorithm is unsupported
  696        ->  http_status_reply(bad_request('Algorithm Unsupported'), Out,
  697                              ['Tus-Resumable'('1.0.0')],
  698                              _Code)
  699        % Because the checksum is wrong
  700        ;   custom_status_reply(checksum_mismatch, Out,
  701                                ['Tus-Resumable'('1.0.0')])
  702        )
  703    % No checksum, or it checks out.
  704    ;   tus_uri_resource(URI, Resource),
  705        (   resource_expiry(Resource, Expiry, Options)
  706        ->  http_timestamp(Expiry, Expiry_Date),
  707            (   get_time(Time),
  708                debug(tus, "Time: ~q Expiry: ~q~n", [Time, Expiry]),
  709                Time > Expiry
  710            ->  custom_status_reply(gone, Out,
  711                                    ['Tus-Resumable'('1.0.0'),
  712                                     'Upload-Expires'(Expiry_Date)])
  713            ;   patch_resource(Resource, Patch, Offset, Length, New_Offset, Options),
  714                http_status_reply(no_content, Out,
  715                                  ['Tus-Resumable'('1.0.0'),
  716                                   'Upload-Expires'(Expiry_Date),
  717                                   'Upload-Offset'(New_Offset)],
  718                                  _Code))
  719        ;   http_status_reply(not_found(URI), Out,
  720                              ['Tus-Resumable'('1.0.0')],
  721                              _Code)
  722        )
  723    ).
  724tus_dispatch(delete,Options,Request) :-
  725    % Delete
  726    memberchk(request_uri(URI),Request),
  727
  728    tus_uri_resource(URI, Resource),
  729
  730    http_output_stream(Request, Out),
  731
  732    (   delete_resource(Resource, Options)
  733    ->  http_status_reply(no_content, Out,
  734                          ['Tus-Resumable'('1.0.0')],
  735                          _Code)
  736    ;   http_status_reply(not_found(URI), Out,
  737                              ['Tus-Resumable'('1.0.0')],
  738                              _Code)
  739    ).
  740
  741/*
  742 Client implementation
  743
  744*/
  745
  746tus_process_options([], []).
  747tus_process_options([tus_checksum_algorithm(X)|Rest_In],[tus_checksum_algorithm(Y)|Rest_Out]) :-
  748    !,
  749    atomic_list_concat(Y, ',', X),
  750    tus_process_options(Rest_In, Rest_Out).
  751tus_process_options([tus_extension(X)|Rest_In],[tus_extension(Y)|Rest_Out]) :-
  752    !,
  753    atomic_list_concat(Y, ',', X),
  754    tus_process_options(Rest_In, Rest_Out).
  755tus_process_options([tus_max_size(X)|Rest_In],[tus_max_size(Y)|Rest_Out]) :-
  756    !,
  757    atom_number(X,Y),
  758    tus_process_options(Rest_In, Rest_Out).
  759tus_process_options([X|Rest_In],[X|Rest_Out]) :-
  760    tus_process_options(Rest_In, Rest_Out).
  761
  762tus_options(Endpoint, Tus_Options, Options) :-
  763    http_client:headers_option(Options, Options1, Headers),
  764    option(reply_header(Headers), Options, _),
  765    http_client:http_open(Endpoint, In, [method(options),
  766                                         status_code(204)
  767                                         |Options1]),
  768    close(In),
  769    tus_process_options(Headers, Tus_Options).
  770
  771tus_create(Endpoint, File, Length, Resource, Tus_Options, Options) :-
  772    tus_create(Endpoint, File, Length, Resource, _, Tus_Options, Options).
  773
  774tus_create(Endpoint, File, Length, Resource, Reply_Header, Tus_Options, Options) :-
  775    (   check_tus_creation(Tus_Options)
  776    ->  true
  777    ;   throw(error(no_creation_extention(Endpoint), _))),
  778
  779    size_file(File, Length),
  780    parse_upload_metadata(Metadata,[filename-File]),
  781    http_get(Endpoint, Response, [
  782                 method(post),
  783                 request_header('Upload-Length'=Length),
  784                 request_header('Upload-Metadata'=Metadata),
  785                 request_header('Tus-Resumable'='1.0.0'),
  786                 request_header('Content-Length'=0),
  787                 content_length(0),
  788                 reply_header(Reply_Header),
  789                 status_code(Code)
  790                 |Options
  791             ]),
  792    (   status_code(Status,Code)
  793    ->  (   Status = created
  794        ->  memberchk(location(Resource), Reply_Header)
  795        ;   Status = conflict % file already exists
  796        ->  throw(error(file_already_exists(File), _))
  797        ;   throw(error(unhandled_status_code(Code,Response),_)))
  798    ;   throw(error(unhandled_status_code(Code,Response),_))
  799    ).
  800
  801tus_patch(Endpoint, File, Chunk, Position, Tus_Options, Options) :-
  802    tus_patch(Endpoint, File, Chunk, Position, _Reply_Header, Tus_Options, Options).
  803
  804tus_patch(Endpoint, File, Chunk, Position, Reply_Header, Tus_Options, Options) :-
  805    tus_max_retries(Max_Retries),
  806    between(0,Max_Retries,_Tries),
  807    tus_patch_(Endpoint, File, Chunk, Position, Reply_Header, Tus_Options, Options),
  808    !.
  809tus_patch(Endpoint, _, _, _, _, _, _) :-
  810    tus_max_retries(Max_Retries),
  811    throw(error(exceeded_max_retries(Endpoint,Max_Retries),_)).
  812
  813tus_patch_(Endpoint, File, Chunk, Position, Reply_Header, Tus_Options, Options) :- 
  814   setup_call_cleanup(
  815        open(File, read, Stream, [encoding(octet)]),
  816        (   seek(Stream, Position, bof, _),
  817            read_string(Stream, Chunk, String),
  818            tus_generate_checksum_header(String, Header, Tus_Options),
  819            append(Options,Header,HdrExtra),
  820            http_get(Endpoint, Response, [
  821                         method(patch),
  822                         post(bytes('application/offset+octet-stream', String)),
  823                         request_header('Upload-Offset'=Position),
  824                         request_header('Tus-Resumable'='1.0.0'),
  825                         request_header('Content-Length'=Chunk),
  826                         reply_header(Reply_Header),
  827                         status_code(Code)
  828                         |HdrExtra
  829                     ])
  830        ),
  831        close(Stream)
  832    ),
  833    (   status_code(Status,Code)
  834    ->  (   Status = no_content % patched
  835        ->  true
  836        ;   Status = bad_checksum
  837        ->  fail % (i.e. retry)
  838        ;   Status = bad_request % No request algorithm
  839        ->  throw(error(bad_request(Endpoint), _))
  840        ;   Status = not_found
  841        ->  throw(error(not_found(Endpoint), _))
  842        ;   Status = gone
  843        ->  throw(error(gone(Endpoint),_))
  844        ;   Status = forbidden
  845        ->  throw(error(forbidden(Endpoint),_))
  846        ;   Status = unsupported_media
  847        ->  throw(error(unsupported_media,_))
  848        ;   throw(error(unhandled_status_code(Code,Response),_))
  849        )
  850    ;   throw(error(unhandled_status_code(Code,Response),_))
  851    ).
  852
  853tus_head(Resource_URL, Offset, Length, Options) :-
  854    tus_head(Resource_URL, Offset, Length, _Reply_Header, Options).
  855
  856tus_head(Resource_URL, Offset, Length, Reply_Header, Options) :-
  857    http_get(Resource_URL, _, [
  858                 method(head),
  859                 request_header('Tus-Resumable'='1.0.0'),
  860                 reply_header(Reply_Header),
  861                 status_code(200)
  862                 |Options
  863             ]),
  864    memberchk(upload_offset(Offset_Atom),Reply_Header),
  865    atom_number(Offset_Atom, Offset),
  866    (   memberchk(upload_length(Length_Atom),Reply_Header)
  867    ->  atom_number(Length_Atom, Length)
  868    ;   Length = unknown
  869    ).
  870
  871tus_delete(Resource_URL, Tus_Options, Options) :-
  872    tus_delete(Resource_URL, _Reply_Header, Tus_Options, Options).
  873
  874tus_delete(Resource_URL, Reply_Header, Tus_Options, Options) :-
  875    (   check_tus_termination(Tus_Options)
  876    ->  true
  877    ;   throw(error(no_termination_extention(Resource_URL), _))),
  878
  879    http_get(Resource_URL, Response, [
  880                 method(delete),
  881                 request_header('Tus-Resumable'='1.0.0'),
  882                 reply_header(Reply_Header),
  883                 status_code(Code)
  884                 |Options
  885             ]),
  886
  887    (   status_code(Status, Code)
  888    ->  (   Status = no_content % deleted
  889        ->  true
  890        ;   memberchk(Status, [not_found, gone])
  891        ->  throw(error(resource_does_not_exist(Resource_URL), _))
  892        ;   Status = forbidden
  893        ->  throw(error(forbidden(Resource_URL),_))
  894        ;   throw(error(unhandled_status_code(Code,Response),_))
  895        )
  896    ;   throw(error(unhandled_status_code(Code,Response),_))
  897    ).
 tus_upload(+File, +Endpoint, -Resource_URL, +Options) is semidet
Upload File to Endpoint returning Resource_URL
Arguments:
File- A fully qualified file path
Endpoint- The URL of a TUS server
Resource_URL- The URL which refers to the uploaded resource.
Options- A list of options sent to http_get/3 /
  909tus_upload(File, Endpoint, Resource_URL, Options) :-
  910    tus_options(Endpoint, Tus_Options, Options),
  911    tus_create(Endpoint, File, Length, Resource_URL, Tus_Options, Options),
  912    tus_client_effective_chunk_size(Tus_Options, Chunk_Size),
  913    forall(
  914        chunk_directive(Length, Chunk_Size, Position, Chunk),
  915        (   debug(tus, "Chunk: ~q Position: ~q~n", [Chunk, Position]),
  916            tus_patch(Resource_URL, File, Chunk, Position, Tus_Options, Options)
  917        )
  918    ).
  919
  920tus_upload(File, Endpoint, Resource_URL) :-
  921    tus_upload(File, Endpoint, Resource_URL, []).
 tus_resume(+Endpoint, +Resource_URL, +Options) is semidet
Resume File upload to Endpoint and Resource
Arguments:
Endpoint- The URL of a TUS server
Resource_URL- The URL which refers to the uploaded resource.
Length- Length of the file
Options- A list of options sent to http_get/3 /
  933tus_resume(File, Endpoint, Resource_URL, Options) :-
  934    tus_options(Endpoint, Tus_Options, Options),
  935    tus_head(Resource_URL, Offset, Length, Options),
  936    tus_client_effective_chunk_size(Tus_Options, Chunk_Size),
  937    forall(
  938        chunk_directive(Offset, Length, Chunk_Size, Position, Chunk),
  939        (   debug(tus, "Chunk: ~q Position: ~q~n", [Chunk, Position]),
  940            tus_patch(Resource_URL, File, Chunk, Position, Tus_Options, Options)
  941        )
  942    ).
  943
  944tus_resume(File, Endpoint, Resource_URL) :-
  945    tus_resume(File, Endpoint, Resource_URL, []).
  946
  947/* Tests */
  948
  949:- begin_tests(tus).  950:- use_module(library(random)).  951
  952spawn_server(URL, Port, Options) :-
  953    random_between(49152, 65535, Port),
  954    http_server(tus_dispatch(Options), [port(Port), workers(1)]),
  955    format(atom(URL), 'http://127.0.0.1:~d/files', [Port]).
  956
  957kill_server(Port) :-
  958    http_stop_server(Port,[]).
  959
  960test(send_file, [
  961         setup((set_tus_options([tus_client_chunk_size(4)]),
  962                random_file(tus_storage_test, Path),
  963                make_directory(Path),
  964                Options = [tus_storage_path(Path)],
  965                spawn_server(URL, Port, Options))),
  966         cleanup(kill_server(Port))
  967     ]) :-
  968
  969    random_file('example_txt_tus', File),
  970    open(File, write, Stream),
  971    Content = "asdf fdsa yes yes yes",
  972    format(Stream, '~s', [Content]),
  973    close(Stream),
  974
  975    tus_upload(File, URL, _Resource),
  976
  977    tus_resource_name(File, Name),
  978    tus_resource_path(Name, Resource, Options),
  979    read_file_to_string(Resource, Result, []),
  980
  981    Result = Content.
  982
  983test(send_and_delete_file, [
  984         setup((set_tus_options([tus_client_chunk_size(4)]),
  985                random_file(tus_storage_test, Path),
  986                make_directory(Path),
  987                Options = [tus_storage_path(Path)],
  988                spawn_server(URL, Port, Options))),
  989         cleanup(kill_server(Port))
  990     ]) :-
  991
  992    random_file('example_txt_tus', File),
  993    open(File, write, Stream),
  994    Content = "asdf fdsa yes yes yes",
  995    format(Stream, '~s', [Content]),
  996    close(Stream),
  997
  998    tus_upload(File, URL, Resource),
  999
 1000    tus_resource_name(File, Name),
 1001    tus_resource_path(Name, Resource_Path, Options),
 1002    read_file_to_string(Resource_Path, _Result, []),
 1003
 1004    tus_options(URL, Tus_Options, []),
 1005    tus_delete(Resource, Tus_Options, Options),
 1006    tus_resource_base_path(Resource, Base_Path, Options),
 1007    \+ exists_directory(Base_Path).
 1008
 1009test(check_expiry, [
 1010         setup((set_tus_options([tus_client_chunk_size(4)]),
 1011                random_file(tus_storage_test, Path),
 1012                make_directory(Path),
 1013                Options = [tus_storage_path(Path)],
 1014                spawn_server(URL, Port, Options))),
 1015         cleanup(kill_server(Port))
 1016     ]) :-
 1017
 1018    random_file('example_txt_tus', File),
 1019    open(File, write, Stream),
 1020    Content = "asdf fdsa yes yes yes",
 1021    format(Stream, '~s', [Content]),
 1022    close(Stream),
 1023
 1024    tus_options(URL, Tus_Options, []),
 1025    tus_create(URL, File, _Length, Resource, Reply_Header_Create, []),
 1026    % TODO: This should actually parse as RFC7231
 1027    %       and check the date is in the future.
 1028    memberchk(upload_expires(_Date_String1),
 1029              Reply_Header_Create),
 1030
 1031    tus_patch(Resource, File, 4, 0, Reply_Header_Patch, Tus_Options, []),
 1032    memberchk(upload_expires(_Date_String2),
 1033              Reply_Header_Patch).
 1034
 1035test(expired_reinitiated, [
 1036         setup((set_tus_options([tus_client_chunk_size(4),
 1037                                 tus_expiry_seconds(1)
 1038                                ]),
 1039                random_file(tus_storage_test, Path),
 1040                make_directory(Path),
 1041                Options = [tus_storage_path(Path)],
 1042                spawn_server(URL, Port, Options))),
 1043         cleanup(kill_server(Port)),
 1044         error(gone(Resource),_)
 1045     ]) :-
 1046
 1047    random_file('example_txt_tus', File),
 1048    open(File, write, Stream),
 1049    Content = "asdf fdsa yes yes yes",
 1050    format(Stream, '~s', [Content]),
 1051    close(Stream),
 1052
 1053    tus_options(URL, Tus_Options, []),
 1054    tus_create(URL, File, _Length, Resource, _, []),
 1055    sleep(1),
 1056    tus_patch(Resource, File, 4, 0, Tus_Options, []).
 1057
 1058test(resume, [
 1059         setup((set_tus_options([tus_client_chunk_size(4)]),
 1060                random_file(tus_storage_test, Path),
 1061                make_directory(Path),
 1062                Options = [tus_storage_path(Path)],
 1063                spawn_server(URL, Port, Options))),
 1064         cleanup(kill_server(Port))
 1065     ]) :-
 1066
 1067    random_file('example_txt_tus', File),
 1068    open(File, write, Stream),
 1069    Content = "asdf fdsa yes yes yes",
 1070    format(Stream, '~s', [Content]),
 1071    close(Stream),
 1072
 1073    tus_options(URL, Tus_Options, []),
 1074    tus_create(URL, File, _Length, Resource_URL, _, []),
 1075    tus_patch(Resource_URL, File, 4, 0, Tus_Options, []),
 1076
 1077    tus_resume(File, URL, Resource_URL),
 1078
 1079    tus_resource_name(File, Name),
 1080    tus_resource_path(Name, Resource, Options),
 1081    read_file_to_string(Resource, Result, []),
 1082
 1083    Result = Content.
 1084
 1085test(bad_checksum, [
 1086         setup((set_tus_options([tus_client_chunk_size(4)]),
 1087                random_file(tus_storage_test, Path),
 1088                make_directory(Path),
 1089                Options = [tus_storage_path(Path)],
 1090                spawn_server(URL, Port, Options))),
 1091         cleanup(kill_server(Port)),
 1092         error(exceeded_max_retries(Resource_URL,_Tries),_)
 1093     ]) :-
 1094
 1095    random_file('example_txt_tus', File),
 1096    open(File, write, Stream),
 1097    Content = "something else for a change",
 1098    format(Stream, '~s', [Content]),
 1099    close(Stream),
 1100
 1101    tus_options(URL, Tus_Options, []),
 1102    tus_create(URL, File, _Length, Resource_URL, _, []),
 1103    tus_patch(Resource_URL, File, 4, 0, Tus_Options,
 1104              [request_header('Upload-Checksum'='sha1 33fd0301077bc24fc6513513c71e288fcecc0c66')]).
 1105
 1106test(bad_checksum_algo, [
 1107         setup((set_tus_options([tus_client_chunk_size(4)]),
 1108                random_file(tus_storage_test, Path),
 1109                make_directory(Path),
 1110                Options = [tus_storage_path(Path)],
 1111                spawn_server(URL, Port, Options))),
 1112         cleanup(kill_server(Port)),
 1113         error(bad_request(_),_)
 1114     ]) :-
 1115
 1116    random_file('example_txt_tus', File),
 1117    open(File, write, Stream),
 1118    Content = "something else for a change",
 1119    format(Stream, '~s', [Content]),
 1120    close(Stream),
 1121
 1122    tus_options(URL, Tus_Options, []),
 1123    tus_create(URL, File, _Length, Resource_URL, _, []),
 1124    tus_patch(Resource_URL, File, 4, 0, Tus_Options,
 1125              [request_header('Upload-Checksum'='scrunchy asdffdsa')]).
 1126
 1127/* Authorization
 1128
 1129   A test example with domains.
 1130
 1131 */
 1132:- use_module(library(http/http_authenticate)). 1133
 1134auth_table(me,pass,shangrila).
 1135
 1136fetch_authorization_data(Request, Username, Key) :-
 1137    memberchk(authorization(Text), Request),
 1138    http_authorization_data(Text, basic(Username, Key)).
 1139
 1140authorize(Request,Organization) :-
 1141    fetch_authorization_data(Request, Username, Key_Codes),
 1142    atom_codes(Key,Key_Codes),
 1143    auth_table(Username, Key, Organization).
 1144
 1145:- meta_predicate auth_wrapper(2,+,+). 1146auth_wrapper(Goal,Options,Request) :-
 1147    authorize(Request, Domain),
 1148    call(Goal, [domain(Domain) | Options], Request).
 1149
 1150spawn_auth_server(URL, Port, Options) :-
 1151    random_between(49152, 65535, Port),
 1152    http_server(auth_wrapper(tus_dispatch, Options), [port(Port), workers(1)]),
 1153    format(atom(URL), 'http://127.0.0.1:~d/files', [Port]).
 1154
 1155test(auth_test, [
 1156         setup((set_tus_options([tus_client_chunk_size(4),
 1157                                 tus_expiry_seconds(1)
 1158                                ]),
 1159                random_file(tus_storage_test, Path),
 1160                make_directory(Path),
 1161                Options = [tus_storage_path(Path)],
 1162                spawn_auth_server(URL, Port, [tus_storage_path(Path)]))),
 1163         cleanup(kill_server(Port))
 1164     ]) :-
 1165
 1166    random_file('example_txt_tus', File),
 1167    open(File, write, Stream),
 1168    Content = "asdf fdsa yes yes yes",
 1169    format(Stream, '~s', [Content]),
 1170    close(Stream),
 1171
 1172    tus_upload(File, URL, _Resource, [authorization(basic(me,pass))]),
 1173
 1174    tus_resource_name(File, Name),
 1175    tus_resource_path(Name, Resource, [domain(shangrila) | Options]),
 1176    read_file_to_string(Resource, Result, []),
 1177
 1178    Result = Content.
 1179
 1180test(resumable_endpoint_option, [
 1181         setup((set_tus_options([tus_client_chunk_size(4000),
 1182                                 tus_expiry_seconds(1)
 1183                                ]),
 1184                random_file(tus_storage_test, Path),
 1185                make_directory(Path),
 1186                Base = 'http://cloudapi.com:8080/TerminusX/api/files',
 1187                spawn_auth_server(URL, Port, [resumable_endpoint_base(Base),tus_storage_path(Path)]))),
 1188         cleanup(kill_server(Port))
 1189     ]) :-
 1190
 1191    random_file('example_txt_tus', File),
 1192    open(File, write, Stream),
 1193    Content = "asdf fdsa yes yes yes",
 1194    format(Stream, '~s', [Content]),
 1195    close(Stream),
 1196    tus_options(URL, Tus_Options, [authorization(basic(me,pass))]),
 1197    tus_create(URL, File, _Length, Resource_URL, Tus_Options, [authorization(basic(me,pass))]),
 1198
 1199    string_length(Base, Len),
 1200    sub_string(Resource_URL, 0, Len, _, Base).
 1201
 1202test(conflict, [
 1203         setup((set_tus_options([tus_client_chunk_size(4),
 1204                                 tus_expiry_seconds(1)
 1205                                ]),
 1206                random_file(tus_storage_test, Path),
 1207                make_directory(Path),
 1208                spawn_auth_server(URL, Port, [tus_storage_path(Path)]))),
 1209         cleanup(kill_server(Port)),
 1210         error(file_already_exists(File) ,_)
 1211     ]) :-
 1212
 1213    random_file('example_txt_tus', File),
 1214    open(File, write, Stream),
 1215    Content = "And now for something completely different...",
 1216    format(Stream, '~s', [Content]),
 1217    close(Stream),
 1218
 1219    tus_upload(File, URL, _Resource1, [authorization(basic(me,pass))]),
 1220    tus_upload(File, URL, _Resource2, [authorization(basic(me,pass))]).
 1221
 1222:- end_tests(tus).