1/*  Part of SWISH
    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		         CWI, Amsterdam
    8    All rights reserved.
    9
   10    Redistribution and use in source and binary forms, with or without
   11    modification, are permitted provided that the following conditions
   12    are met:
   13
   14    1. Redistributions of source code must retain the above copyright
   15       notice, this list of conditions and the following disclaimer.
   16
   17    2. Redistributions in binary form must reproduce the above copyright
   18       notice, this list of conditions and the following disclaimer in
   19       the documentation and/or other materials provided with the
   20       distribution.
   21
   22    THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
   23    "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
   24    LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
   25    FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
   26    COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT,
   27    INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
   28    BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
   29    LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
   30    CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
   31    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
   32    ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
   33    POSSIBILITY OF SUCH DAMAGE.
   34*/
   35
   36:- module(download,
   37	  [ download_button/2			% +Data, +Options
   38	  ]).   39:- use_module(library(pengines)).   40:- use_module(library(option)).   41:- use_module(library(settings)).   42:- use_module(library(apply)).   43:- use_module(library(http/mimetype)).   44:- use_module(library(http/http_dispatch)).   45:- use_module(library(http/http_parameters)).

   57:- setting(keep_downloads_time, number, 86400,
   58	   "Seconds to keep a downloaded file").

 download_button(+Data:string, +Options)

Emit a button in the SWISH output window for downloading Data. The provided data is stored on the server.

Options:

filename(+Name)

(Base-)Name of the file created (default: swish-download.dat),

content_type(+Type)

Full content type. By default this is derived from the extension of the filename and the encoding.

encoding(+Enc)

Encoding to use. One of utf8 or octet. default is utf8.

See also

- https://en.wikipedia.org/wiki/Data_URI_scheme

   79download_button(Data, Options) :-
   80	option(filename(FileName), Options, 'swish-download.dat'),
   81	option(encoding(Enc), Options, utf8),
   82	(   option(content_type(ContentType), Options)
   83	->  true
   84	;   file_mime_type(FileName, Major/Minor),
   85	    atomics_to_string([Major, Minor], /, ContentType0),
   86	    add_charset(Enc, ContentType0, ContentType)
   87	),
   88	save_download_data(Data, UUID, Enc),
   89	pengine_output(
   90	    json{action:downloadButton,
   91		 content_type:ContentType,
   92		 encoding: Enc,
   93		 uuid:UUID,
   94		 filename:FileName
   95		}).
   96
   97add_charset(utf8, Enc0, Enc) :- !,
   98	atom_concat(Enc0, '; charset=UTF-8', Enc).
   99add_charset(_, Enc, Enc).
  100
  101
  102		 /*******************************
  103		 *	      SERVER		*
  104		 *******************************/
  105
  106:- http_handler(swish(download), download, [id(download), prefix, method(get)]).

 download(+Request)

Handle a download request.

  112download(Request) :-
  113	http_parameters(Request,
  114			[ uuid(UUID, []),
  115			  content_type(Type, [])
  116			]),
  117	download_file(UUID, File),
  118	http_reply_file(File,
  119			[ mime_type(Type),
  120			  unsafe(true)
  121			],
  122			Request).
  123
  124
  125		 /*******************************
  126		 *	       STORE		*
  127		 *******************************/

 save_download_data(+Data, -UUID, +Encoding) is det

Save the string Data in the download store and return a UUID to retreive it.

  134save_download_data(Data, UUID, Encoding) :-
  135	download_file(UUID, Path),
  136	ensure_parents(Path),
  137	setup_call_cleanup(
  138	    open(Path, write, Out, [encoding(Encoding)]),
  139	    write(Out, Data),
  140	    close(Out)),
  141	prune_downloads.

 download_file(?UUID, -Path)

Path is the full file from which to download Name.

To be done

- We could use the SHA1 of the data. In that case we need to touch the file if it exists and we need a way to ensure the file is completely saved by a concurrent thread that may save the same file.

  153download_file(UUID, Path) :-
  154	(   var(UUID)
  155	->  uuid(UUID)
  156	;   true
  157	),
  158	variant_sha1(UUID, SHA1),
  159	sub_atom(SHA1, 0, 2, _, Dir0),
  160	sub_atom(SHA1, 2, 2, _, Dir1),
  161	sub_atom(SHA1, 4, _, 0, File),
  162	download_dir(Dir),
  163	atomic_list_concat([Dir, Dir0, Dir1, File], /, Path).

 download_dir(-Dir) is det

Find the download base directory.

  170:- dynamic download_dir_cache/1.  171:- volatile download_dir_cache/1.  172
  173download_dir(Dir) :-
  174	download_dir_cache(Dir),
  175	!.
  176download_dir(Dir) :-
  177	absolute_file_name(data(download), Dir,
  178			   [ file_type(directory),
  179			     access(write),
  180			     file_errors(fail)
  181			   ]),
  182	!,
  183	asserta(download_dir_cache(Dir)).
  184download_dir(Dir) :-
  185	absolute_file_name(data(download), Dir,
  186			   [ solutions(all)
  187			   ]),
  188	catch(make_directory(Dir), error(_,_), fail),
  189	!,
  190	asserta(download_dir_cache(Dir)).
  191
  192ensure_parents(Path) :-
  193	file_directory_name(Path, Dir1),
  194	file_directory_name(Dir1, Dir0),
  195	ensure_directory(Dir0),
  196	ensure_directory(Dir1).
  197
  198ensure_directory(Dir) :-
  199	exists_directory(Dir),
  200	!.
  201ensure_directory(Dir) :-
  202	make_directory(Dir).

 prune_downloads

Prune old download files. This is actually executed every 1/4th of the time we keep the files. This makes this call fast.

  210:- dynamic pruned_at/1.  211:- volatile pruned_at/1.  212
  213prune_downloads :-
  214	E = error(_,_),
  215	with_mutex(download,
  216		   catch(prune_downloads_sync, E,
  217			 print_message(warning, E))).
  218
  219prune_downloads_sync :-
  220	pruned_at(Last),
  221	setting(keep_downloads_time, Time),
  222	get_time(Now),
  223	Now < Last + Time/4,
  224	!.
  225prune_downloads_sync :-
  226	thread_create(do_prune_downloads, _,
  227		      [ alias(prune_downloads),
  228			detached(true)
  229		      ]),
  230	get_time(Now),
  231	retractall(pruned_at(_)),
  232	asserta(pruned_at(Now)).
  233
  234do_prune_downloads :-
  235	get_time(Now),
  236	setting(keep_downloads_time, Time),
  237	Before is Now - Time,
  238	download_dir(Dir),
  239	prune_dir(Dir, Before, false).

 prune_dir(+Dir, +Time, +PruneDir) is det

Find all files older than Time and delete them as well as empty directories.

  246prune_dir(Dir, Time, PruneDir) :-
  247	directory_files(Dir, Files0),
  248	exclude(reserved, Files0, Files),
  249	exclude(clean_entry(Dir, Time), Files, Rest),
  250	(   Rest == [],
  251	    PruneDir == true
  252	->  E = error(_,_),
  253	    catch(delete_directory(Dir), E,
  254		  print_message(warning, E))
  255	;   true
  256	).
  257
  258reserved(.).
  259reserved(..).

 clean_entry(+Dir, +Time, +File) is semidet

True when Dir/File has been cleaned and is removed.

  265clean_entry(Dir, Time, File) :-
  266	directory_file_path(Dir, File, Path),
  267	(   exists_directory(Path)
  268	->  prune_dir(Path, Time, true),
  269	    \+ exists_directory(Path)
  270	;   time_file(Path, FTime),
  271	    FTime < Time
  272	->  E = error(_,_),
  273	    catch(delete_file(Path), E,
  274		  ( print_message(warning, E),
  275		    fail
  276		  ))
  277	)