View source with raw comments or as raw
    1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2009-2019, VU University Amsterdam
    7			      CWI, Amsterdam
    8
    9    This program is free software; you can redistribute it and/or
   10    modify it under the terms of the GNU General Public License
   11    as published by the Free Software Foundation; either version 2
   12    of the License, or (at your option) any later version.
   13
   14    This program is distributed in the hope that it will be useful,
   15    but WITHOUT ANY WARRANTY; without even the implied warranty of
   16    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   17    GNU General Public License for more details.
   18
   19    You should have received a copy of the GNU General Public
   20    License along with this library; if not, write to the Free Software
   21    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   22
   23    As a special exception, if you link this library with other files,
   24    compiled with a Free Software compiler, to produce an executable, this
   25    library does not by itself cause the resulting executable to be covered
   26    by the GNU General Public License. This exception does not however
   27    invalidate any other reasons why the executable file might be covered by
   28    the GNU General Public License.
   29*/
   30
   31:- module(plweb_download, []).   32:- use_module(library(http/html_write)).   33:- use_module(library(http/js_write)).   34:- use_module(library(http/http_dispatch)).   35:- use_module(library(http/http_path)).   36:- use_module(library(http/http_parameters)).   37:- use_module(library(http/http_dirindex)).   38:- use_module(library(http/http_wrapper)).   39:- use_module(library(dcg/basics)).   40:- use_module(library(broadcast)).   41:- use_module(library(pairs)).   42:- use_module(library(lists)).   43:- use_module(library(apply)).   44:- use_module(library(error)).   45:- use_module(library(filesex)).   46:- use_module(library(persistency)).   47:- use_module(library(crypto)).   48:- use_module(library(random)).   49:- use_module(wiki).
 download(+Request) is det
HTTP handler for SWI-Prolog download pages.
   55:- http_handler(download(devel),        download_table, []).   56:- http_handler(download(stable),       download_table, []).   57:- http_handler(download(old),          download_table, []).   58:- http_handler(download('daily/bin/'), download_daily, []).   59:- http_handler(download(.),	        download,
   60		[prefix, spawn(download), priority(10)]).
 download_table(+Request)
Provide a table with possible download targets. test edit
   67download_table(Request) :-
   68	http_parameters(Request,
   69			[ show(Show, [oneof([all,latest]), default(latest)])
   70			]),
   71	memberchk(path(Path), Request),
   72	http_absolute_location(root(download), DownLoadRoot, []),
   73	atom_concat(DownLoadRoot, DownLoadDir, Path),
   74	absolute_file_name(download(DownLoadDir),
   75			   Dir,
   76			   [ file_type(directory),
   77			     access(read)
   78			   ]),
   79	list_downloads(Dir, [show(Show), request(Request)]).
 list_downloads(+Directory)
   83list_downloads(Dir, Options) :-
   84	(   wiki_file_to_dom(Dir, 'header.txt', Header0)
   85	->  (   Header0 = [h1(_, Title)|Header]
   86	    ->	true
   87	    ;	Header = Header0
   88	    )
   89	;   Header = []
   90	),
   91	(   var(Title)
   92	->  Title = 'SWI-Prolog downloads'
   93	;   true
   94	),
   95	reply_html_page(
   96	    download(Dir, Title),
   97	    title('SWI-Prolog downloads'),
   98	    [ \html(Header),
   99	      br(clear(all)),
  100	      table(class(downloads),
  101		    \download_table(Dir, Options)),
  102	      \machine_download_text,
  103	      \wiki(Dir, 'footer.txt')
  104	    ]).
  105
  106wiki_file_to_dom(Dir, File, DOM) :-
  107	directory_file_path(Dir, File, WikiFile),
  108	access_file(WikiFile, read), !,
  109	wiki_file_to_dom(WikiFile, DOM).
  110
  111wiki(Dir, File) -->
  112	{ wiki_file_to_dom(Dir, File, DOM) }, !,
  113	html(DOM).
  114wiki(_, _) -->
  115	[].
  116
  117machine_download_text -->
  118	html({|html||
  119<div class="machine-download">
  120Install scripts may download the SHA256 checksum by appending
  121<code>.sha256</code> to the file name.  Scripts can download
  122the latest version by replacing the version of the file with
  123<code>latest</code>.  This causes the server to reply with the
  124location of the latest version using an
  125<code>HTTP 303 See Other</code> message.
  126</div>
  127	     |}).
  128
  129
  130download_table(Dir, Options) -->
  131	list_files(Dir, bin, bin,    'Binaries',         Options),
  132	list_files(Dir, src, src,    'Sources',          Options),
  133	list_files(Dir, doc, doc,    'Documentation',    Options),
  134	toggle_show(Options).
 toggle_show(+Options) is det
Add a toggle to switch between showing only the latest version and all versions.
  141toggle_show(Options) -->
  142	{ option(request(Request), Options),
  143	  memberchk(path(Path), Request), !,
  144	  file_base_name(Path, MySelf),
  145	  (   option(show(all), Options)
  146	  ->  NewShow = latest
  147	  ;   NewShow = all
  148	  )
  149	},
  150	html(tr(td([class(toggle), colspan(3)],
  151		   a(href(MySelf+'?show='+NewShow),
  152		     [ 'Show ', NewShow, ' files' ])))).
  153toggle_show(_) -->
  154	[].
 list_files(+Dir, +SubDir, +Class, +Label, +Options) is det
Create table rows for all files in Dir/SubDir. If files are present, emit a tr with Label and a tr row for each each matching file. Options are:
show(Show)
One of all or latest (default).
  165list_files(Dir, SubDir, Class, Label, Options) -->
  166	{ directory_file_path(Dir, SubDir, Directory),
  167	  download_files(Directory, Class, Files, Options),
  168	  Files \== []
  169	},
  170	html(tr(th(colspan(3), Label))),
  171	list_files(Files).
  172list_files(_, _, _, _, _) -->
  173	[].
  174
  175list_files([]) --> [].
  176list_files([H|T]) -->
  177	list_file(H),
  178	list_files(T).
  179
  180list_file(File) -->
  181	html(tr(class(download),
  182		[ td(class(dl_icon), \file_icon(File)),
  183		  td(class(dl_size), \file_size(File)),
  184		  td(class(dl_file), \file_description(File))
  185		])).
  186
  187file_icon(file(Type, PlatForm, _, _, _)) -->
  188	{ icon_for_file(Type, PlatForm, Icon, Alt), !,
  189	  http_absolute_location(icons(Icon), HREF, [])
  190	},
  191	html(img([src(HREF), alt(Alt)])).
  192file_icon(_) -->
  193	html(?).			% no defined icon
  194
  195icon_for_file(bin, linux(universal),
  196	      'linux.png', 'Linux 32/64 intel').
  197icon_for_file(bin, linux(_,_),
  198	      'linux32.gif', 'Linux RPM').
  199icon_for_file(bin, macos(lion,_),
  200	      'lion.png', 'Lion').
  201icon_for_file(bin, macos(snow_leopard,_),
  202	      'snowleopard.gif', 'Snow Leopard').
  203icon_for_file(bin, macos(snow_leopard_and_later,_),
  204	      'macapp.png', 'Snow Leopard and later').
  205icon_for_file(bin, macos(bundle,_),
  206	      'macapp.png', 'MacOS bundle').
  207icon_for_file(bin, macos(_,_),
  208	      'mac.gif', 'MacOSX version').
  209icon_for_file(_, windows(win32),
  210	      'win32.gif', 'Windows version (32-bits)').
  211icon_for_file(_, windows(win64),
  212	      'win64.gif', 'Windows version (64-bits)').
  213icon_for_file(src, _,
  214	      'src.gif', 'Source archive').
  215icon_for_file(_, pdf,
  216	      'pdf.gif', 'PDF file').
  217
  218
  219file_size(file(_, _, _, _, Path)) -->
  220	{ size_file(Path, Bytes)
  221	},
  222	html('~D bytes'-[Bytes]).
  223
  224file_description(file(bin, PlatForm, Version, _, Path)) -->
  225	{ down_file_href(Path, HREF)
  226	},
  227	html([ a(href(HREF),
  228		 [ 'SWI-Prolog ', \version(Version), ' for ',
  229		   \platform(PlatForm)
  230		 ]),
  231	       \platform_notes(PlatForm, Path),
  232	       \checksum(Path)
  233	     ]).
  234file_description(file(src, Format, Version, _, Path)) -->
  235	{ down_file_href(Path, HREF)
  236	},
  237	html([ a(href(HREF),
  238		 [ 'SWI-Prolog source for ', \version(Version)
  239		 ]),
  240	       \platform_notes(Format, Path),
  241	       \checksum(Path)
  242	     ]).
  243file_description(file(doc, Format, Version, _, Path)) -->
  244	{ down_file_href(Path, HREF)
  245	},
  246	html([ a(href(HREF),
  247		 [ 'SWI-Prolog ', \version(Version),
  248		   ' reference manual in PDF'
  249		 ]),
  250	       \platform_notes(Format, Path)
  251	     ]).
  252file_description(file(pkg(Pkg), PlatForm, Version, _, Path)) -->
  253	{ down_file_href(Path, HREF)
  254	},
  255	html([ a(href(HREF),
  256		 [ \package(Pkg), ' (version ', \version(Version), ') for ',
  257		   \platform(PlatForm)
  258		 ]),
  259	       \platform_notes(pkg(Pkg), Path)
  260	     ]).
  261
  262package(Name) -->
  263	html([ 'Package ', Name ]).
  264
  265version(version(Major, Minor, Patch, '')) --> !,
  266	html(b('~w.~w.~w'-[Major, Minor, Patch])).
  267version(version(Major, Minor, Patch, Tag)) -->
  268	html(b('~w.~w.~w-~w'-[Major, Minor, Patch, Tag])).
  269
  270checksum(Path) -->
  271	{ file_checksum(Path, SHA256) },
  272	html(div([ class(checksum),
  273		   title('You can use the checksum to verify the integrity \c
  274		          of the downloaded file.  It provides some protection \c
  275			  against deliberate tamporing with the file.')
  276		 ],
  277		 [ span(class('checkum-header'), 'SHA256'), :,
  278		   span(class([checksum,sha256]), SHA256)
  279		 ])).
  280
  281down_file_href(Path, HREF) :-
  282	absolute_file_name(download(.),
  283			   Dir,
  284			   [ file_type(directory),
  285			     access(read)
  286			   ]),
  287	atom_concat(Dir, SlashLocal, Path),
  288	delete_leading_slash(SlashLocal, Local),
  289	add_envelope(Local, SafeLocal),
  290	http_absolute_location(download(SafeLocal), HREF, []).
  291
  292delete_leading_slash(SlashPath, Path) :-
  293	atom_concat(/, Path, SlashPath), !.
  294delete_leading_slash(Path, Path).
  295
  296platform(linux(universal)) -->
  297	html(['Linux 32/64 bits (TAR)']).
  298platform(linux(rpm, _)) -->
  299	html(['i586/Linux (RPM)']).
  300platform(macos(Name, CPU)) -->
  301	html(['MacOSX ', \html_macos_version(Name), ' on ', b(CPU)]).
  302platform(windows(win32)) -->
  303	html(['Microsoft Windows (32 bit)']).
  304platform(windows(win64)) -->
  305	html(['Microsoft Windows (64 bit)']).
  306
  307html_macos_version(tiger)        --> html('10.4 (Tiger)').
  308html_macos_version(leopard)      --> html('10.5 (Leopard)').
  309html_macos_version(snow_leopard) --> html('10.6 (Snow Leopard)').
  310html_macos_version(lion)	 --> html('10.7 (Lion)').
  311html_macos_version(snow_leopard_and_later) --> html('10.6 (Snow Leopard) and later').
  312html_macos_version(bundle)       --> html('10.12 (Sierra) and later').
  313html_macos_version(OS)	         --> html(OS).
 platform_notes(+Platform, +Path) is det
Include notes on the platform. These notes are stored in a wiki file in the same directory as the download file.
  320platform_notes(Platform, Path) -->
  321	{ file_directory_name(Path, Dir),
  322	  platform_note_file(Platform, File),
  323	  atomic_list_concat([Dir, /, File], NoteFile),
  324	  debug(download, 'Trying note-file ~q', [NoteFile]),
  325	  access_file(NoteFile, read), !,
  326	  debug(download, 'Found note-file ~q', [NoteFile]),
  327	  wiki_file_to_dom(NoteFile, DOM)
  328	},
  329	html(DOM).
  330platform_notes(_, _) -->
  331	[].
  332
  333platform_note_file(linux(rpm,_),     'linux-rpm.txt').
  334platform_note_file(linux(universal), 'linux.txt').
  335platform_note_file(windows(win32),   'win32.txt').
  336platform_note_file(windows(win64),   'win64.txt').
  337platform_note_file(pkg(Pkg),         File) :-
  338	file_name_extension(Pkg, txt, File).
  339platform_note_file(macos(Version,_), File) :-
  340	atomic_list_concat([macosx, -, Version, '.txt'], File).
  341platform_note_file(macos(_,_),	     'macosx.txt').
  342platform_note_file(tgz,		     'src-tgz.txt').
  343platform_note_file(pdf,		     'doc-pdf.txt').
  344
  345
  346		 /*******************************
  347		 *	   CLASSIFY FILES	*
  348		 *******************************/
 download_files(+Dir, +Class, -Files, +Options)
Files is a list of files that satisfy Class and Options in Dir/Subdir.
  355:- dynamic
  356	download_cache/6.  % Hash, Dir, Class, Opts, Time, Files
  357
  358download_files(Dir, Class, Files, Options0) :-
  359	exists_directory(Dir), !,
  360	include(download_option, Options0, Options),
  361	term_hash(ci(Dir,Class,Options), Hash),
  362	time_file(Dir, DirTime),
  363	(   download_cache(Hash, Dir, Class, Options, Time, Files0),
  364	    (	DirTime == Time
  365	    ->	true
  366	    ;	retractall(download_cache(Hash, Dir, Class, Options, _, _)),
  367		fail
  368	    )
  369	->  true
  370	;   download_files_nc(Dir, Class, Files0, Options),
  371	    asserta(download_cache(Hash, Dir, Class, Options, DirTime, Files0))
  372	),
  373	Files = Files0.
  374download_files(_, _, [], _).
  375
  376clear_download_cache :-
  377	retractall(download_cache(_Hash, _Dir, _Class, _Options, _Time, _Files0)).
  378
  379download_option(show(_)).
  380
  381
  382download_files_nc(Directory, Class, Sorted, Options) :-
  383	atom_concat(Directory, '/*', Pattern),
  384	expand_file_name(Pattern, Files),
  385	classify_files(Files, Class, Classified, Options),
  386	sort_files(Classified, Sorted, Options).
  387
  388classify_files([], _, [], _).
  389classify_files([H0|T0], Class, [H|T], Options) :-
  390	classify_file(H0, H, Options),
  391	arg(1, H, Classification),
  392	subsumes_term(Class, Classification), !,
  393	classify_files(T0, Class, T, Options).
  394classify_files([_|T0], Class, T, Options) :-
  395	classify_files(T0, Class, T, Options).
 classify_file(+Path, -Term, +Options) is semidet
  399classify_file(Path, file(Type, Platform, Version, Name, Path), Options) :-
  400	file_base_name(Path, Name),
  401	atom_codes(Name, Codes),
  402	phrase(file(Type, Platform, Version, Options), Codes).
  403
  404file(bin, macos(OSVersion, CPU), Version, Options) -->
  405	{ option(show(all), Options) },
  406	"swi-prolog-", opt_devel, long_version(Version), "-",
  407	macos_version(OSVersion),
  408	(   "-",
  409	    macos_cpu(CPU)
  410	->  ""
  411	;   { macos_def_cpu(OSVersion, CPU) }
  412	),
  413	".mpkg.zip", !.
  414% Cmake version
  415file(bin, macos(bundle, intel), Version, _) -->
  416	"swipl-", long_version(Version), opt_release(_),
  417	opt_cpu(_),
  418	".dmg", !.
  419file(bin, macos(snow_leopard_and_later, intel), Version, _) -->
  420	"SWI-Prolog-", long_version(Version),
  421	".dmg", !.
  422file(bin, windows(WinType), Version, _) -->
  423	"swipl-", long_version(Version), opt_release(_),
  424	cmake_win_type(WinType),
  425	".exe", !.
  426file(bin, windows(WinType), Version, _) -->
  427	win_type(WinType), "pl",
  428	short_version(Version),
  429	".exe", !.
  430file(bin, windows(WinType), Version, _) -->
  431	swipl, win_type(WinType), "-",
  432	short_version(Version),
  433	".exe", !.
  434file(bin, linux(rpm, suse), Version, _) -->
  435	swipl, long_version(Version), "-", digits(_Build), ".i586.rpm", !.
  436file(bin, linux(universal), Version, _) -->
  437	"swipl-",
  438	long_version(Version), "-", "linux",
  439	".tar.gz", !.
  440file(src, tgz, Version, _) -->
  441	swipl, long_version(Version), ".tar.gz", !.
  442file(doc, pdf, Version, _) -->
  443	"SWI-Prolog-", long_version(Version), ".pdf", !.
  444
  445swipl --> "swipl-", !.
  446swipl --> "pl-".
  447
  448opt_release(Rel) --> "-", int(Rel, 4), !.
  449opt_release(-)   --> "".
  450
  451opt_devel --> "devel-", !.
  452opt_devel --> "".
  453
  454opt_cpu(x86_64) --> ".", "x86_64", !.
  455opt_cpu(unknown) --> "".
  456
  457macos_version(tiger)        --> "tiger".
  458macos_version(leopard)      --> "leopard".
  459macos_version(snow_leopard) --> "snow-leopard".
  460macos_version(lion)         --> "lion".
  461
  462macos_cpu(ppc)   --> "powerpc".
  463macos_cpu(intel) --> "intel".
  464macos_cpu(x86)   --> "32bit".
  465
  466macos_def_cpu(snow_leopard, intel) :- !.
  467macos_def_cpu(lion, intel) :- !.
  468macos_def_cpu(_, ppc).
  469
  470win_type(win32) --> "w32".
  471win_type(win64) --> "w64".
  472
  473cmake_win_type(win64) --> ".", "x64".
  474cmake_win_type(win32) --> ".", "x86".
  475
  476long_version(version(Major, Minor, Patch, Tag)) -->
  477	int(Major, 1), ".", int(Minor, 2), ".", int(Patch, 2), !,
  478        tag(Tag), !.
  479long_version(latest) -->
  480	"latest".
  481
  482tag(Tag) -->
  483	"-", alnums(Codes), !,
  484        { atom_codes(Tag, Codes) }.
  485tag('') --> "".
  486
  487int(Value, MaxDigits) -->
  488	digits(Digits),
  489	{ length(Digits, Len),
  490	  Len =< MaxDigits,
  491	  Len > 0,
  492	  number_codes(Value, Digits)
  493	}.
  494
  495alnums([H|T]) -->
  496	[H], { code_type(H, alnum) }, !,
  497        alnums(T).
  498alnums([]) --> "".
  499
  500short_version(version(Major, Minor, Patch, Tag)) -->
  501	digits(Digits),
  502	{   Digits = [D1,D2,D3]
  503	->  number_codes(Major, [D1]),
  504	    number_codes(Minor, [D2]),
  505	    number_codes(Patch, [D3])
  506	;   Digits = [D1,D2,D3,D4]
  507	->  (   number_codes(51, [D1,D2])		% 5.1X.Y
  508	    ->  number_codes(Major, [D1]),
  509	        number_codes(Minor, [D2,D3]),
  510		number_codes(Patch, [D4])
  511	    ;   number_codes(Major, [D1]),
  512	        number_codes(Minor, [D2]),
  513		number_codes(Patch, [D3,D4])
  514	    )
  515	;   Digits = [D1,D2,D3,D4,D5]
  516	->  number_codes(Major, [D1]),
  517	    number_codes(Minor, [D2,D3]),
  518	    number_codes(Patch, [D4,D5])
  519	},
  520        tag(Tag), !.
  521short_version(latest) -->
  522	"latest".
 sort_files(+In, -Out, +Options)
Sort files by type and version. Type: linux, windows, mac, src, doc. Versions: latest first.

Options:

show(Show)
One of all or latest.
  534sort_files(In, Out, Options) :-
  535	map_list_to_pairs(map_type, In, Typed0),
  536	(   option(show(all), Options)
  537	->  Typed = Typed0
  538	;   exclude(old_tagged_file, Typed0, Typed)
  539	),
  540	keysort(Typed, TSorted),
  541	group_pairs_by_key(TSorted, TGrouped),
  542	maplist(sort_group_by_version, TGrouped, TGroupSorted),
  543	(   option(show(all), Options)
  544	->  pairs_values(TGroupSorted, TValues),
  545	    flatten(TValues, Out)
  546	;   take_latest(TGroupSorted, Out)
  547	).
  548
  549map_type(File, Tag) :-
  550	File = file(Type, Platform, _Version, _Name, _Path),
  551	type_tag(Type, Platform, Tag).
  552
  553type_tag(bin, linux(A),   tag(10, linux(A))) :- !.
  554type_tag(bin, linux(A,B), tag(11, linux(A,B))) :- !.
  555type_tag(bin, windows(A), tag(Tg, windows(A))) :- !,
  556	win_tag(A, Tg2),
  557        Tg is 20+Tg2.
  558type_tag(bin, macos(A,B), tag(Tg, macos(A,B))) :- !,
  559	mac_tag(A, Tg2),
  560	Tg is 30+Tg2.
  561type_tag(src, Format,     tag(40, Format)) :- !.
  562type_tag(doc, Format,     tag(50, Format)) :- !.
  563type_tag(X,   Y,	  tag(60, X-Y)).
  564
  565mac_tag(bundle,			4).
  566mac_tag(snow_leopard_and_later,	5).
  567mac_tag(lion,			6).
  568mac_tag(snow_leopard,		7).
  569mac_tag(leopard,		8).
  570mac_tag(tiger,			9).
  571
  572win_tag(win64, 1).
  573win_tag(win32, 2).
  574
  575sort_group_by_version(Tag-Files, Tag-Sorted) :-
  576	map_list_to_pairs(tag_version, Files, TFiles),
  577	keysort(TFiles, TRevSorted),
  578	pairs_values(TRevSorted, RevSorted),
  579	reverse(RevSorted, Sorted).
  580
  581tag_version(File, Tag) :-
  582	File = file(_,_,Version,_,_),
  583	version_tag(Version, Tag).
  584
  585version_tag(version(Major, Minor, Patch, Tag),
  586	    version(Major, Minor, Patch, Order)) :-
  587	(   pre_version(Tag, Order)
  588	->  true
  589	;   print_message(error,
  590			  error(domain_error(pre_release_version, Tag),_)),
  591	    Order = pre(-100, 0)
  592	).
  593
  594pre_version('', pre(0, 0)) :- !.
  595pre_version(NrA, pre(0, 0)) :-
  596	atom_number(NrA, _Nr), !.
  597pre_version(Tag, pre(TagOrder, N)) :-
  598	tag(TagPrefix, TagOrder),
  599	atom_concat(TagPrefix, NA, Tag),
  600	atom_number(NA, N).
  601
  602tag(rc,    -1).
  603tag(beta,  -2).
  604tag(alpha, -3).
  605
  606take_latest([], []).
  607take_latest([_-[H|_]|T0], [H|T]) :- !,
  608	take_latest(T0, T).
  609take_latest([_-[]|T0], T) :- !,		% emty set
  610	take_latest(T0, T).
 old_tagged_file(+TypeFile) is semidet
  614old_tagged_file(tag(_,Type)-_File) :-
  615	old_file_type(Type).
  616
  617old_file_type(linux(_)).
  618old_file_type(linux(_,_)).
  619old_file_type(macos(_,ppc)).
  620old_file_type(macos(tiger,_)).
  621old_file_type(macos(snow_leopard_and_later,_)).
  622
  623
  624		 /*******************************
  625		 *	     DOWNLOAD		*
  626		 *******************************/
 download(+Request) is det
Actually download a file. Two special requests are supported:
  637download(Request) :-
  638	memberchk(path_info(Download), Request),
  639	file_name_extension(File, envelope, Download), !,
  640	envelope(File).
  641download(Request) :-
  642	memberchk(path_info(Download), Request),
  643	(   file_name_extension(File, sha256, Download)
  644	->  true
  645	;   File = Download
  646	),
  647	download_file(File, AbsFile),
  648	(   File == Download
  649	->  http_peer(Request, Remote),
  650	    broadcast(download(File, Remote)),
  651	    http_reply_file(AbsFile, [unsafe(true)], Request)
  652	;   file_checksum(AbsFile, SHA256),
  653	    format('Content-type: text/plain~n~n'),
  654	    format('~w~n', [SHA256])
  655	).
  656download(Request) :-
  657	memberchk(path_info(Download), Request),
  658	classify_file(Download, file(Class,Platform,latest,_,_), [show(last)]),
  659	file_directory_name(Download, Dir),
  660	absolute_file_name(download(Dir),
  661			   AbsDir,
  662			   [ access(read),
  663			     file_type(directory),
  664			     file_errors(fail)
  665			   ]),
  666	download_files(AbsDir, Class, Files, [show(last)]),
  667	memberchk(file(Class, Platform, _, File, _), Files), !,
  668	directory_file_path(Dir, File, Redirect),
  669	http_link_to_id(download, path_postfix(Redirect), URI),
  670	http_redirect(see_other, URI, Request).
  671download(Request) :-
  672	(   memberchk(path_info(Download), Request)
  673	->  true
  674	;   Download = '.'
  675	),
  676	absolute_file_name(download(Download),
  677			   AbsFile,
  678			   [ access(read),
  679			     file_errors(fail),
  680			     file_type(directory)
  681			   ]), !,
  682	http_reply_dirindex(AbsFile,
  683			    [ unsafe(true),
  684			      name(name_cell)
  685			    ], Request).
  686download(Request) :-
  687	memberchk(path(Path), Request),
  688	existence_error(http_location, Path).
  689
  690download_file(File, AbsFile) :-
  691	absolute_file_name(download(File),
  692			   AbsFile,
  693			   [ access(read),
  694			     file_errors(fail)
  695			   ]).
  696
  697:- public
  698	name_cell//1.  699
  700name_cell(File) -->
  701	{ needs_envelope(File),
  702	  file_base_name(File, Name),
  703	  uri_encoded(path, Name, Ref0),
  704	  file_name_extension(Ref0, envelope, Ref)
  705	},
  706	html(a(href(Ref), Name)).
  707name_cell(File) -->
  708	{ file_base_name(File, Name),
  709	  uri_encoded(path, Name, Ref)
  710	},
  711	html(a(href(Ref), Name)).
 download_daily(+Request)
Provide the download page for the windows binaries.
  717download_daily(_Request) :-
  718	absolute_file_name(download('daily/bin'), Dir,
  719			   [ file_type(directory),
  720			     access(read)
  721			   ]),
  722	reply_html_page(
  723	    download(Dir, 'Download daily builds for Windows'),
  724	    title('Download daily builds for Windows'),
  725	    [ \explain_win_daily,
  726	      \directory_index(Dir,
  727			       [ order_by(time),
  728				 order(descending),
  729				 name(name_cell)
  730			       ])
  731	    ]).
  732
  733
  734explain_win_daily -->
  735	html({|html||
  736	      <p>The table below provides access to the most recent 7
  737	      daily builds of SWI-Prolog for Windows, both the 32- and
  738	      64-bit versions.  The build is done automatically from the
  739	      <a href="/git/">GIT sources</a>.  The files use the following
  740	      naming convention:
  741	      </p>
  742	      <ul>
  743	        <li><code>swipl-w</code><var>bits</var><code>-</code><var>date</var><code>.exe</code>
  744	      </ul>
  745	      <p>
  746	      Please note that these versions <b>may be unstable!</b>  It is
  747	      adviced to follow current discussions on the
  748	      <a href="/Mailinglist.html">mailing
  749	      list</a> and/or the git commit messages at
  750	      <a href="https://github.com/SWI-Prolog/swipl-devel">GitHub</a>.
  751	      The primary purpose of the daily builds is to quickly provide
  752	      binaries after a bug report.
  753	      </p>
  754	     |}).
  755
  756
  757		 /*******************************
  758		 *	      ENVELOPE		*
  759		 *******************************/
  760
  761needs_envelope(File) :-
  762	file_name_extension(_, exe, File).
  763
  764add_envelope(File, Envelope) :-
  765	needs_envelope(File),
  766	!,
  767	file_name_extension(File, envelope, Envelope).
  768add_envelope(File, File).
  769
  770envelope(File) :-
  771	maybe(0.1),
  772	download_file(File, AbsFile),
  773	file_checksum(AbsFile, OkHash),
  774	compute_file_checksum(AbsFile, NewHash),
  775	NewHash \== OkHash,
  776	!,
  777	reply_html_page(
  778	    download(File, 'Possibly tampered binary'),
  779	    title('Possibly tampered binary'),
  780	    \tampered(File, OkHash, NewHash)).
  781envelope(File) :-
  782	file_base_name(File, Base),
  783	reply_html_page(
  784	    download(Base, 'Download binary'),
  785	    title('Download a binary file'),
  786	    \envelope(File)).
  787
  788envelope(File) -->
  789	{ http_absolute_location(icons('alert.gif'), Alert, []),
  790	  http_absolute_location(icons('vt_logo.png'), VTLogo, []),
  791	  download_file(File, AbsFile),
  792	  file_checksum(AbsFile, Hash),
  793	  file_base_name(File, Base),
  794	  format(atom(VTHREF), 'https://www.virustotal.com/file/~w/analysis/', Hash)
  795	},
  796	html({|html(Base, Hash, VTHREF, VTLogo, Alert)||
  797<p><img src=Alert style="float:left">
  798Windows antivirus software works using <i>signatures</i> and <i>heuristics</i>.
  799Using the huge amount of virusses and malware known today, arbitrary executables
  800are often <a href="https://en.wikipedia.org/wiki/Antivirus_software#Problems_caused_by_false_positives">falsily classified as malicious</a>.
  801<a href="https://safebrowsing.google.com/">Google Safe Browsing</a>, used by
  802most modern browsers, therefore often classifies our Windows binaries as
  803malware. You can use e.g., <a href="https://www.virustotal.com/gui/home/url">virustotal</a> to verify files with a large number of antivirus programs.
  804</p>
  805
  806<p>
  807Our Windows binaries are cross-compiled on an isolated Linux container.  The
  808integrity of the binaries on the server is regularly verified by validating its
  809SHA256 fingerprint.
  810</p>
  811
  812<p>
  813Please select the checkbox below to enable the actual download link.
  814</p>
  815
  816<table>
  817<tr><td><input type="checkbox" id="understand"><td>I understand</tr>
  818<tr><td><td><a id="download">Download <code>Base</code></a>
  819<span style="color:#888; font-size:small;">(SHA256: <code>Hash</code>)</span></tr>
  820<tr><td style="text-align:right"><img src=VTLogo style="width:1.5ex"><td><a href=VTHREF>VIRUSTOTAL Scan Result</a></tr>
  821</table>
  822	     |}),
  823	js_script({|javascript(Base)||
  824$(function() {
  825  $("#understand").prop("checked", false)
  826                  .on("click", function() {
  827    $("#download").attr("href", Base);
  828  });
  829});
  830
  831		  |}).
  832
  833tampered(File, OkHash, NewHash) -->
  834	{ http_absolute_location(icons('alert.gif'), Alert, [])
  835	},
  836	html({|html(File, Alert, OkHash, NewHash)||
  837<p><img src=Alert style="float:left">
  838The file <code>File</code> SHA256 signature has changed.  Please
  839report this at <a href="mailto:bugs@swi-prolog.org">bugs@swi-prolog.org</a>
  840	     |}).
  841
  842
  843		 /*******************************
  844		 *	     CHECKSUMS		*
  845		 *******************************/
  846
  847:- persistent
  848	sha256(path:atom,
  849	       sha256:atom).  850
  851attach_db :-
  852	db_attached('checksum.db'), !.
  853attach_db :-
  854	db_attach('checksum.db', []).
 file_checksum(+Path:atom, -Sum:atom) is det
True when Sum is the SHA256 checksum of file. We keep this in the Prolog database because this simplifies uploading files. Although the data under control of the server and thus more vulnerable than the download area on disk because that is not writeable by the server, I think this is also better from a security point of view because it requires the attacker to both modify the filesystem and the server, something that requires different rights and expertise.
  867file_checksum(Path, Sum) :-
  868	attach_db,
  869	sha256(Path, Sum0), !,
  870	Sum = Sum0.
  871file_checksum(Path, Sum) :-
  872	compute_file_checksum(Path, Sum).
  873
  874compute_file_checksum(Path, Sum) :-
  875	crypto_file_hash(Path, Sum,
  876			 [ encoding(octet),
  877			   algorithm(sha256)
  878			 ]),
  879	assert_sha256(Path, Sum)