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)).   46
   47/** <module> Provide a button for downloading data
   48
   49This module allows a button to be  inserted into the Pengine output that
   50allows for downloading data. Originally this   used the `data` type URL.
   51This has been disabled in recent   browsers. Also considering the length
   52limitations on URLs on some browsers we   now store the data server-side
   53and make the link simply download the  data.   The  data  is kept on the
   54server for `keep_downloads_time` seconds, default 24 hours.
   55*/
   56
   57:- setting(keep_downloads_time, number, 86400,
   58	   "Seconds to keep a downloaded file").   59
   60%!	download_button(+Data:string, +Options)
   61%
   62%	Emit a button in the SWISH   output window for downloading Data.
   63%	The provided data  is  stored  on   the  server.
   64%
   65%	Options:
   66%
   67%	  - filename(+Name)
   68%	    (Base-)Name of the file created (default:
   69%	    `swish-download.dat`),
   70%	  - content_type(+Type)
   71%	    Full content type.  By default this is derived from the
   72%	    extension of the filename and the encoding.
   73%	  - encoding(+Enc)
   74%	    Encoding to use. One of `utf8` or `octet`. default is
   75%	    `utf8`.
   76%
   77%	@see https://en.wikipedia.org/wiki/Data_URI_scheme
   78
   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)]).  107
  108%!	download(+Request)
  109%
  110%	Handle a download request.
  111
  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		 *******************************/
  128
  129%!	save_download_data(+Data, -UUID, +Encoding) is det.
  130%
  131%	Save the string Data in the download store and return a UUID to
  132%	retreive it.
  133
  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.
  142
  143
  144%!	download_file(?UUID, -Path)
  145%
  146%	Path is the full file from which to download Name.
  147%
  148%	@tbd We could use the SHA1 of the  data. In that case we need to
  149%	_touch_ the file if it exists and we   need  a way to ensure the
  150%	file is completely saved by a   concurrent  thread that may save
  151%	the same file.
  152
  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).
  164
  165
  166%!	download_dir(-Dir) is det.
  167%
  168%	Find the download base directory.
  169
  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).
  203
  204
  205%!	prune_downloads
  206%
  207%	Prune old download files. This is actually executed every 1/4th
  208%	of the time we keep the files.  This makes this call fast.
  209
  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).
  240
  241%!	prune_dir(+Dir, +Time, +PruneDir) is det.
  242%
  243%	Find all files older than Time and  delete them as well as empty
  244%	directories.
  245
  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(..).
  260
  261%!	clean_entry(+Dir, +Time, +File) is semidet.
  262%
  263%	True when Dir/File has been cleaned and is removed.
  264
  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	)