31
32:- module(plweb_download, []). 33:- use_module(library(http/html_write)). 34:- use_module(library(http/js_write)). 35:- use_module(library(http/http_dispatch)). 36:- use_module(library(http/http_path)). 37:- use_module(library(http/http_parameters)). 38:- use_module(library(http/http_dirindex)). 39:- use_module(library(http/http_wrapper)). 40:- use_module(library(http/http_cors)). 41:- use_module(library(dcg/basics)). 42:- use_module(library(broadcast)). 43:- use_module(library(pairs)). 44:- use_module(library(lists)). 45:- use_module(library(apply)). 46:- use_module(library(error)). 47:- use_module(library(filesex)). 48:- use_module(library(persistency)). 49:- use_module(library(crypto)). 50:- use_module(library(random)). 51:- use_module(wiki). 52
56
57:- http_handler(download(devel), download_table, []). 58:- http_handler(download(stable), download_table, []). 59:- http_handler(download(old), download_table, []). 60:- http_handler(download('daily/bin/'), download_daily, []). 61:- http_handler(download(.), download,
62 [prefix, spawn(download), priority(10)]). 63:- http_handler(root(download), http_redirect(moved, download(.)),
64 [priority(10)]). 65
70
71download_table(Request) :-
72 http_parameters(Request,
73 [ show(Show, [oneof([all,latest]), default(latest)])
74 ]),
75 memberchk(path(Path), Request),
76 http_absolute_location(root(download), DownLoadRoot, []),
77 atom_concat(DownLoadRoot, DownLoadDir, Path),
78 absolute_file_name(download(DownLoadDir),
79 Dir,
80 [ file_type(directory),
81 access(read)
82 ]),
83 list_downloads(Dir, [show(Show), request(Request)]).
84
86
87list_downloads(Dir, Options) :-
88 ( wiki_file_to_dom(Dir, 'header.txt', Header0)
89 -> ( Header0 = [h1(_, Title)|Header]
90 -> true
91 ; Header = Header0
92 )
93 ; Header = []
94 ),
95 ( var(Title)
96 -> Title = 'SWI-Prolog downloads'
97 ; true
98 ),
99 reply_html_page(
100 download(Dir, Title),
101 title('SWI-Prolog downloads'),
102 [ \html(Header),
103 br(clear(all)),
104 table(class(downloads),
105 \download_table(Dir, Options)),
106 \machine_download_text,
107 \wiki(Dir, 'footer.txt')
108 ]).
109
110wiki_file_to_dom(Dir, File, DOM) :-
111 directory_file_path(Dir, File, WikiFile),
112 access_file(WikiFile, read), !,
113 wiki_file_to_dom(WikiFile, DOM).
114
115wiki(Dir, File) -->
116 { wiki_file_to_dom(Dir, File, DOM) }, !,
117 html(DOM).
118wiki(_, _) -->
119 [].
120
121machine_download_text -->
122 html({|html||
123<div class="machine-download">
124Install scripts may download the SHA256 checksum by appending
125<code>.sha256</code> to the file name. Scripts can download
126the latest version by replacing the version of the file with
127<code>latest</code>. This causes the server to reply with the
128location of the latest version using an
129<code>HTTP 303 See Other</code> message.
130</div>
131 |}).
132
133
134download_table(Dir, Options) -->
135 list_files(Dir, bin, bin, 'Binaries', Options),
136 list_files(Dir, src, src, 'Sources', Options),
137 list_files(Dir, doc, doc, 'Documentation', Options),
138 toggle_show(Options).
139
144
145toggle_show(Options) -->
146 { option(request(Request), Options),
147 memberchk(path(Path), Request), !,
148 file_base_name(Path, MySelf),
149 ( option(show(all), Options)
150 -> NewShow = latest
151 ; NewShow = all
152 )
153 },
154 html(tr(td([class(toggle), colspan(3)],
155 a(href(MySelf+'?show='+NewShow),
156 [ 'Show ', NewShow, ' files' ])))).
157toggle_show(_) -->
158 [].
159
168
169list_files(Dir, SubDir, Class, Label, Options) -->
170 { directory_file_path(Dir, SubDir, Directory),
171 download_files(Directory, Class, Files, Options),
172 Files \== []
173 },
174 html(tr(th(colspan(3), Label))),
175 list_files(Files).
176list_files(_, _, _, _, _) -->
177 [].
178
179list_files([]) --> [].
180list_files([H|T]) -->
181 list_file(H),
182 list_files(T).
183
184list_file(File) -->
185 html(tr(class(download),
186 [ td(class(dl_icon), \file_icon(File)),
187 td(class(dl_size), \file_size(File)),
188 td(class(dl_file), \file_description(File))
189 ])).
190
191file_icon(file(Type, PlatForm, _, _, _)) -->
192 { icon_for_file(Type, PlatForm, Icon, Alt), !,
193 http_absolute_location(icons(Icon), HREF, [])
194 },
195 html(img([src(HREF), alt(Alt)])).
196file_icon(_) -->
197 html(?). 198
199icon_for_file(bin, linux(universal),
200 'linux.png', 'Linux 32/64 intel').
201icon_for_file(bin, linux(_,_),
202 'linux32.gif', 'Linux RPM').
203icon_for_file(bin, macos(lion,_),
204 'lion.png', 'Lion').
205icon_for_file(bin, macos(snow_leopard,_),
206 'snowleopard.gif', 'Snow Leopard').
207icon_for_file(bin, macos(snow_leopard_and_later,_),
208 'macapp.png', 'Snow Leopard and later').
209icon_for_file(bin, macos(bundle,_),
210 'macapp.png', 'MacOS bundle').
211icon_for_file(bin, macos(_,_),
212 'mac.gif', 'MacOSX version').
213icon_for_file(_, windows(win32),
214 'win32.gif', 'Windows version (32-bits)').
215icon_for_file(_, windows(win64),
216 'win64.gif', 'Windows version (64-bits)').
217icon_for_file(src, _,
218 'src.gif', 'Source archive').
219icon_for_file(_, pdf,
220 'pdf.gif', 'PDF file').
221
222
223file_size(file(_, _, _, _, Path)) -->
224 { size_file(Path, Bytes)
225 },
226 html('~D bytes'-[Bytes]).
227
228file_description(file(bin, PlatForm, Version, _, Path)) -->
229 { down_file_href(Path, HREF)
230 },
231 html([ a(href(HREF),
232 [ 'SWI-Prolog ', \version(Version), ' for ',
233 \platform(PlatForm)
234 ]),
235 \platform_notes(PlatForm, Path),
236 \checksum(Path)
237 ]).
238file_description(file(src, Format, Version, _, Path)) -->
239 { down_file_href(Path, HREF)
240 },
241 html([ a(href(HREF),
242 [ 'SWI-Prolog source for ', \version(Version)
243 ]),
244 \platform_notes(Format, Path),
245 \checksum(Path)
246 ]).
247file_description(file(doc, Format, Version, _, Path)) -->
248 { down_file_href(Path, HREF)
249 },
250 html([ a(href(HREF),
251 [ 'SWI-Prolog ', \version(Version),
252 ' reference manual in PDF'
253 ]),
254 \platform_notes(Format, Path)
255 ]).
256file_description(file(pkg(Pkg), PlatForm, Version, _, Path)) -->
257 { down_file_href(Path, HREF)
258 },
259 html([ a(href(HREF),
260 [ \package(Pkg), ' (version ', \version(Version), ') for ',
261 \platform(PlatForm)
262 ]),
263 \platform_notes(pkg(Pkg), Path)
264 ]).
265
266package(Name) -->
267 html([ 'Package ', Name ]).
268
269version(version(Major, Minor, Patch, '')) --> !,
270 html(b('~w.~w.~w'-[Major, Minor, Patch])).
271version(version(Major, Minor, Patch, Tag)) -->
272 html(b('~w.~w.~w-~w'-[Major, Minor, Patch, Tag])).
273
274checksum(Path) -->
275 { file_checksum(Path, SHA256) },
276 html(div([ class(checksum),
277 title('You can use the checksum to verify the integrity \c
278 of the downloaded file. It provides some protection \c
279 against deliberate tamporing with the file.')
280 ],
281 [ span(class('checkum-header'), 'SHA256'), :,
282 span(class([checksum,sha256]), SHA256)
283 ])).
284
285down_file_href(Path, HREF) :-
286 absolute_file_name(download(.),
287 Dir,
288 [ file_type(directory),
289 access(read)
290 ]),
291 atom_concat(Dir, SlashLocal, Path),
292 delete_leading_slash(SlashLocal, Local),
293 add_envelope(Local, SafeLocal),
294 http_absolute_location(download(SafeLocal), HREF, []).
295
296delete_leading_slash(SlashPath, Path) :-
297 atom_concat(/, Path, SlashPath), !.
298delete_leading_slash(Path, Path).
299
300platform(linux(universal)) -->
301 html(['Linux 32/64 bits (TAR)']).
302platform(linux(rpm, _)) -->
303 html(['i586/Linux (RPM)']).
304platform(macos(Name, CPU)) -->
305 html(['MacOSX ', \html_macos_version(Name, CPU), ' on ', \cpu(CPU)]).
306platform(windows(win32)) -->
307 html(['Microsoft Windows (32 bit)']).
308platform(windows(win64)) -->
309 html(['Microsoft Windows (64 bit)']).
310
311html_macos_version(tiger, _) --> html('10.4 (Tiger)').
312html_macos_version(leopard, _) --> html('10.5 (Leopard)').
313html_macos_version(snow_leopard, _) --> html('10.6 (Snow Leopard)').
314html_macos_version(lion, _) --> html('10.7 (Lion)').
315html_macos_version(snow_leopard_and_later, _)
316 --> html('10.6 (Snow Leopard) and later').
317html_macos_version(bundle, x86_64) --> html('10.12 (Sierra) and later').
318html_macos_version(bundle, fat) --> html('10.14 (Mojave) and later').
319html_macos_version(OS, _CPU) --> html(OS).
320
321cpu(fat) --> !, html("x86_64 and arm64").
322cpu(CPU) --> html(CPU).
323
324
329
330platform_notes(Platform, Path) -->
331 { file_directory_name(Path, Dir),
332 platform_note_file(Platform, File),
333 atomic_list_concat([Dir, /, File], NoteFile),
334 debug(download, 'Trying note-file ~q', [NoteFile]),
335 access_file(NoteFile, read), !,
336 debug(download, 'Found note-file ~q', [NoteFile]),
337 wiki_file_to_dom(NoteFile, DOM)
338 },
339 html(DOM).
340platform_notes(_, _) -->
341 [].
342
343platform_note_file(linux(rpm,_), 'linux-rpm.txt').
344platform_note_file(linux(universal), 'linux.txt').
345platform_note_file(windows(win32), 'win32.txt').
346platform_note_file(windows(win64), 'win64.txt').
347platform_note_file(pkg(Pkg), File) :-
348 file_name_extension(Pkg, txt, File).
349platform_note_file(macos(Version,fat), File) :-
350 atomic_list_concat([macosx, -, fat, -, Version, '.txt'], File).
351platform_note_file(macos(Version,_), File) :-
352 atomic_list_concat([macosx, -, Version, '.txt'], File).
353platform_note_file(macos(_,_), 'macosx.txt').
354platform_note_file(tgz, 'src-tgz.txt').
355platform_note_file(pdf, 'doc-pdf.txt').
356
357
358 361
366
367:- dynamic
368 download_cache/6. 369
370download_files(Dir, Class, Files, Options0) :-
371 exists_directory(Dir), !,
372 include(download_option, Options0, Options),
373 term_hash(ci(Dir,Class,Options), Hash),
374 time_file(Dir, DirTime),
375 ( download_cache(Hash, Dir, Class, Options, Time, Files0),
376 ( DirTime == Time
377 -> true
378 ; retractall(download_cache(Hash, Dir, Class, Options, _, _)),
379 fail
380 )
381 -> true
382 ; download_files_nc(Dir, Class, Files0, Options),
383 asserta(download_cache(Hash, Dir, Class, Options, DirTime, Files0))
384 ),
385 Files = Files0.
386download_files(_, _, [], _).
387
388clear_download_cache :-
389 retractall(download_cache(_Hash, _Dir, _Class, _Options, _Time, _Files0)).
390
391download_option(show(_)).
392
393
394download_files_nc(Directory, Class, Sorted, Options) :-
395 atom_concat(Directory, '/*', Pattern),
396 expand_file_name(Pattern, Files),
397 classify_files(Files, Class, Classified, Options),
398 sort_files(Classified, Sorted, Options).
399
400classify_files([], _, [], _).
401classify_files([H0|T0], Class, [H|T], Options) :-
402 classify_file(H0, H, Options),
403 arg(1, H, Classification),
404 subsumes_term(Class, Classification), !,
405 classify_files(T0, Class, T, Options).
406classify_files([_|T0], Class, T, Options) :-
407 classify_files(T0, Class, T, Options).
408
410
411classify_file(Path, file(Type, Platform, Version, Name, Path), Options) :-
412 file_base_name(Path, Name),
413 atom_codes(Name, Codes),
414 phrase(file(Type, Platform, Version, Options), Codes).
415
416file(bin, macos(OSVersion, CPU), Version, Options) -->
417 { option(show(all), Options) },
418 "swi-prolog-", opt_devel, long_version(Version), "-",
419 macos_version(OSVersion),
420 ( "-",
421 macos_cpu(CPU)
422 -> ""
423 ; { macos_def_cpu(OSVersion, CPU) }
424 ),
425 ".mpkg.zip", !.
427file(bin, macos(bundle, intel), Version, _) -->
428 "swipl-", long_version(Version), opt_release(_),
429 opt_cpu(_),
430 ".dmg", !.
431file(bin, macos(bundle, fat), Version, _) -->
432 "swipl-", long_version(Version), opt_release(_),
433 ".fat.dmg", !.
434file(bin, macos(snow_leopard_and_later, intel), Version, _) -->
435 "SWI-Prolog-", long_version(Version),
436 ".dmg", !.
437file(bin, windows(WinType), Version, _) -->
438 "swipl-", long_version(Version), opt_release(_),
439 cmake_win_type(WinType),
440 ".exe", !.
441file(bin, windows(WinType), Version, _) -->
442 win_type(WinType), "pl",
443 short_version(Version),
444 ".exe", !.
445file(bin, windows(WinType), Version, _) -->
446 swipl, win_type(WinType), "-",
447 short_version(Version),
448 ".exe", !.
449file(bin, linux(rpm, suse), Version, _) -->
450 swipl, long_version(Version), "-", digits(_Build), ".i586.rpm", !.
451file(bin, linux(universal), Version, _) -->
452 "swipl-",
453 long_version(Version), "-", "linux",
454 ".tar.gz", !.
455file(src, tgz, Version, _) -->
456 swipl, long_version(Version), ".tar.gz", !.
457file(doc, pdf, Version, _) -->
458 "SWI-Prolog-", long_version(Version), ".pdf", !.
459
460swipl --> "swipl-", !.
461swipl --> "pl-".
462
463opt_release(Rel) --> "-", int(Rel, 4), !.
464opt_release(-) --> "".
465
466opt_devel --> "devel-", !.
467opt_devel --> "".
468
469opt_cpu(x86_64) --> ".", "x86_64", !.
470opt_cpu(unknown) --> "".
471
472macos_version(tiger) --> "tiger".
473macos_version(leopard) --> "leopard".
474macos_version(snow_leopard) --> "snow-leopard".
475macos_version(lion) --> "lion".
476
477macos_cpu(ppc) --> "powerpc".
478macos_cpu(intel) --> "intel".
479macos_cpu(x86) --> "32bit".
480
481macos_def_cpu(snow_leopard, intel) :- !.
482macos_def_cpu(lion, intel) :- !.
483macos_def_cpu(_, ppc).
484
485win_type(win32) --> "w32".
486win_type(win64) --> "w64".
487
488cmake_win_type(win64) --> ".", "x64".
489cmake_win_type(win32) --> ".", "x86".
490
491long_version(version(Major, Minor, Patch, Tag)) -->
492 int(Major, 1), ".", int(Minor, 2), ".", int(Patch, 2), !,
493 tag(Tag), !.
494long_version(latest) -->
495 "latest".
496
497tag(Tag) -->
498 "-", alnums(Codes), !,
499 { atom_codes(Tag, Codes) }.
500tag('') --> "".
501
502int(Value, MaxDigits) -->
503 digits(Digits),
504 { length(Digits, Len),
505 Len =< MaxDigits,
506 Len > 0,
507 number_codes(Value, Digits)
508 }.
509
510alnums([H|T]) -->
511 [H], { code_type(H, alnum) }, !,
512 alnums(T).
513alnums([]) --> "".
514
515short_version(version(Major, Minor, Patch, Tag)) -->
516 digits(Digits),
517 { Digits = [D1,D2,D3]
518 -> number_codes(Major, [D1]),
519 number_codes(Minor, [D2]),
520 number_codes(Patch, [D3])
521 ; Digits = [D1,D2,D3,D4]
522 -> ( number_codes(51, [D1,D2]) 523 -> number_codes(Major, [D1]),
524 number_codes(Minor, [D2,D3]),
525 number_codes(Patch, [D4])
526 ; number_codes(Major, [D1]),
527 number_codes(Minor, [D2]),
528 number_codes(Patch, [D3,D4])
529 )
530 ; Digits = [D1,D2,D3,D4,D5]
531 -> number_codes(Major, [D1]),
532 number_codes(Minor, [D2,D3]),
533 number_codes(Patch, [D4,D5])
534 },
535 tag(Tag), !.
536short_version(latest) -->
537 "latest".
538
548
549sort_files(In, Out, Options) :-
550 map_list_to_pairs(map_type, In, Typed0),
551 ( option(show(all), Options)
552 -> Typed = Typed0
553 ; exclude(old_tagged_file, Typed0, Typed)
554 ),
555 keysort(Typed, TSorted),
556 group_pairs_by_key(TSorted, TGrouped),
557 maplist(sort_group_by_version, TGrouped, TGroupSorted),
558 ( option(show(all), Options)
559 -> pairs_values(TGroupSorted, TValues),
560 flatten(TValues, Out)
561 ; take_latest(TGroupSorted, Out)
562 ).
563
564map_type(File, Tag) :-
565 File = file(Type, Platform, _Version, _Name, _Path),
566 type_tag(Type, Platform, Tag).
567
568type_tag(bin, linux(A), tag(10, linux(A))) :- !.
569type_tag(bin, linux(A,B), tag(11, linux(A,B))) :- !.
570type_tag(bin, windows(A), tag(Tg, windows(A))) :- !,
571 win_tag(A, Tg2),
572 Tg is 20+Tg2.
573type_tag(bin, macos(A,B), tag(Tg, macos(A,B))) :- !,
574 mac_tag(A, Tg2),
575 Tg is 30+Tg2.
576type_tag(src, Format, tag(40, Format)) :- !.
577type_tag(doc, Format, tag(50, Format)) :- !.
578type_tag(X, Y, tag(60, X-Y)).
579
580mac_tag(bundle, 4).
581mac_tag(snow_leopard_and_later, 5).
582mac_tag(lion, 6).
583mac_tag(snow_leopard, 7).
584mac_tag(leopard, 8).
585mac_tag(tiger, 9).
586
587win_tag(win64, 1).
588win_tag(win32, 2).
589
590sort_group_by_version(Tag-Files, Tag-Sorted) :-
591 map_list_to_pairs(tag_version, Files, TFiles),
592 keysort(TFiles, TRevSorted),
593 pairs_values(TRevSorted, RevSorted),
594 reverse(RevSorted, Sorted).
595
596tag_version(File, Tag) :-
597 File = file(_,_,Version,_,_),
598 version_tag(Version, Tag).
599
600version_tag(version(Major, Minor, Patch, Tag),
601 version(Major, Minor, Patch, Order)) :-
602 ( pre_version(Tag, Order)
603 -> true
604 ; print_message(error,
605 error(domain_error(pre_release_version, Tag),_)),
606 Order = pre(-100, 0)
607 ).
608
609pre_version('', pre(0, 0)) :- !.
610pre_version(NrA, pre(0, 0)) :-
611 atom_number(NrA, _Nr), !.
612pre_version(Tag, pre(TagOrder, N)) :-
613 tag(TagPrefix, TagOrder),
614 atom_concat(TagPrefix, NA, Tag),
615 atom_number(NA, N).
616
617tag(rc, -1).
618tag(beta, -2).
619tag(alpha, -3).
620
621take_latest([], []).
622take_latest([_-[H|_]|T0], [H|T]) :- !,
623 take_latest(T0, T).
624take_latest([_-[]|T0], T) :- !, 625 take_latest(T0, T).
626
628
629old_tagged_file(tag(_,Type)-_File) :-
630 old_file_type(Type).
631
632old_file_type(linux(_)).
633old_file_type(linux(_,_)).
634old_file_type(macos(_,ppc)).
635old_file_type(macos(tiger,_)).
636old_file_type(macos(snow_leopard_and_later,_)).
637
638
639 642
651
652download(Request) :-
653 memberchk(path_info(Download), Request),
654 file_name_extension(File, envelope, Download), !,
655 envelope(File).
656download(Request) :-
657 memberchk(path_info(Download), Request),
658 ( file_name_extension(File, sha256, Download)
659 -> true
660 ; File = Download
661 ),
662 download_file(File, AbsFile),
663 cors_enable,
664 format('Cross-origin-resource-policy: cross-origin\n'),
665 ( File == Download
666 -> http_peer(Request, Remote),
667 broadcast(download(File, Remote)),
668 http_reply_file(AbsFile, [unsafe(true)], Request)
669 ; file_checksum(AbsFile, SHA256),
670 format('Content-type: text/plain~n~n'),
671 format('~w~n', [SHA256])
672 ).
673download(Request) :-
674 memberchk(path_info(Download), Request),
675 classify_file(Download, file(Class,Platform,latest,_,_), [show(last)]),
676 file_directory_name(Download, Dir),
677 absolute_file_name(download(Dir),
678 AbsDir,
679 [ access(read),
680 file_type(directory),
681 file_errors(fail)
682 ]),
683 download_files(AbsDir, Class, Files, [show(last)]),
684 memberchk(file(Class, Platform, _, File, _), Files), !,
685 directory_file_path(Dir, File, Redirect),
686 http_link_to_id(download, path_postfix(Redirect), URI),
687 http_redirect(see_other, URI, Request).
688download(Request) :-
689 ( memberchk(path_info(Download), Request)
690 -> http_safe_file(download(Download), [])
691 ; Download = '.'
692 ),
693 absolute_file_name(download(Download),
694 AbsFile,
695 [ access(read),
696 file_errors(fail),
697 file_type(directory)
698 ]), !,
699 http_reply_dirindex(AbsFile,
700 [ unsafe(true),
701 name(name_cell)
702 ], Request).
703download(Request) :-
704 memberchk(path(Path), Request),
705 existence_error(http_location, Path).
706
707download_file(File, AbsFile) :-
708 http_safe_file(download(File), []),
709 absolute_file_name(download(File),
710 AbsFile,
711 [ access(read),
712 file_errors(fail)
713 ]).
714
715:- public
716 name_cell//1. 717
718name_cell(File) -->
719 { needs_envelope(File),
720 file_base_name(File, Name),
721 uri_encoded(path, Name, Ref0),
722 file_name_extension(Ref0, envelope, Ref)
723 },
724 html(a(href(Ref), Name)).
725name_cell(File) -->
726 { file_base_name(File, Name),
727 uri_encoded(path, Name, Ref)
728 },
729 html(a(href(Ref), Name)).
730
734
735download_daily(_Request) :-
736 absolute_file_name(download('daily/bin'), Dir,
737 [ file_type(directory),
738 access(read)
739 ]),
740 reply_html_page(
741 download(Dir, 'Download daily builds for Windows'),
742 title('Download daily builds for Windows'),
743 [ \explain_win_daily,
744 \directory_index(Dir,
745 [ order_by(time),
746 order(descending),
747 name(name_cell)
748 ])
749 ]).
750
751
752explain_win_daily -->
753 html({|html||
754 <p>The table below provides access to the most recent 7
755 daily builds of SWI-Prolog for Windows, both the 32- and
756 64-bit versions. The build is done automatically from the
757 <a href="/git/">GIT sources</a>. The files use the following
758 naming convention:
759 </p>
760 <ul>
761 <li><code>swipl-w</code><var>bits</var><code>-</code><var>date</var><code>.exe</code>
762 </ul>
763 <p>
764 Please note that these versions <b>may be unstable!</b> It is
765 adviced to follow current discussions on the
766 <a href="/Mailinglist.html">mailing
767 list</a> and/or the git commit messages at
768 <a href="https://github.com/SWI-Prolog/swipl-devel">GitHub</a>.
769 The primary purpose of the daily builds is to quickly provide
770 binaries after a bug report.
771 </p>
772 |}).
773
774
775 778
779needs_envelope(File) :-
780 file_name_extension(_, exe, File).
781
782add_envelope(File, Envelope) :-
783 needs_envelope(File),
784 !,
785 file_name_extension(File, envelope, Envelope).
786add_envelope(File, File).
787
788envelope(File) :-
789 maybe(0.1),
790 download_file(File, AbsFile),
791 file_checksum(AbsFile, OkHash),
792 compute_file_checksum(AbsFile, NewHash),
793 NewHash \== OkHash,
794 !,
795 reply_html_page(
796 download(File, 'Possibly tampered binary'),
797 title('Possibly tampered binary'),
798 \tampered(File, OkHash, NewHash)).
799envelope(File) :-
800 file_base_name(File, Base),
801 reply_html_page(
802 download(Base, 'Download binary'),
803 title('Download a binary file'),
804 \envelope(File)).
805
806envelope(File) -->
807 { http_absolute_location(icons('alert.gif'), Alert, []),
808 http_absolute_location(icons('vt_logo.png'), VTLogo, []),
809 download_file(File, AbsFile),
810 file_checksum(AbsFile, Hash),
811 file_base_name(File, Base),
812 format(atom(VTHREF), 'https://www.virustotal.com/file/~w/analysis/', Hash)
813 },
814 html({|html(Base, Hash, VTHREF, VTLogo, Alert)||
815<p><img src=Alert style="float:left">
816Windows antivirus software works using <i>signatures</i> and <i>heuristics</i>.
817Using the huge amount of virusses and malware known today, arbitrary executables
818are often <a href="https://en.wikipedia.org/wiki/Antivirus_software#Problems_caused_by_false_positives">falsily classified as malicious</a>.
819<a href="https://safebrowsing.google.com/">Google Safe Browsing</a>, used by
820most modern browsers, therefore often classifies our Windows binaries as
821malware. 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.
822</p>
823
824<p>
825Our Windows binaries are cross-compiled on an isolated Linux container. The
826integrity of the binaries on the server is regularly verified by validating its
827SHA256 fingerprint.
828</p>
829
830<p>
831Please select the checkbox below to enable the actual download link.
832</p>
833
834<table>
835<tr><td><input type="checkbox" id="understand"><td>I understand</tr>
836<tr><td><td><a id="download">Download <code>Base</code></a>
837<span style="color:#888; font-size:small;">(SHA256: <code>Hash</code>)</span></tr>
838<tr><td style="text-align:right"><img src=VTLogo style="width:1.5ex"><td><a href=VTHREF>VIRUSTOTAL Scan Result</a></tr>
839</table>
840 |}),
841 js_script({|javascript(Base)||
842$(function() {
843 $("#understand").prop("checked", false)
844 .on("click", function() {
845 $("#download").attr("href", Base);
846 });
847});
848
849 |}).
850
851tampered(File, OkHash, NewHash) -->
852 { http_absolute_location(icons('alert.gif'), Alert, [])
853 },
854 html({|html(File, Alert, OkHash, NewHash)||
855<p><img src=Alert style="float:left">
856The file <code>File</code> SHA256 signature has changed. Please
857report this at <a href="mailto:bugs@swi-prolog.org">bugs@swi-prolog.org</a>
858 |}).
859
860
861 864
865:- persistent
866 sha256(path:atom,
867 sha256:atom). 868
869attach_db :-
870 db_attached('checksum.db'), !.
871attach_db :-
872 db_attach('checksum.db', []).
873
884
885file_checksum(Path, Sum) :-
886 attach_db,
887 sha256(Path, Sum0), !,
888 Sum = Sum0.
889file_checksum(Path, Sum) :-
890 compute_file_checksum(Path, Sum).
891
892compute_file_checksum(Path, Sum) :-
893 crypto_file_hash(Path, Sum,
894 [ encoding(octet),
895 algorithm(sha256)
896 ]),
897 assert_sha256(Path, Sum)