Mercurial > hg > dml-open-cliopatria
comparison cpack/dml/lib/httpfiles.pl @ 0:718306e29690 tip
commiting public release
| author | Daniel Wolff |
|---|---|
| date | Tue, 09 Feb 2016 21:05:06 +0100 |
| parents | |
| children |
comparison
equal
deleted
inserted
replaced
| -1:000000000000 | 0:718306e29690 |
|---|---|
| 1 /* Part of DML (Digital Music Laboratory) | |
| 2 Copyright 2014-2015 Samer Abdallah, University of London | |
| 3 | |
| 4 This program is free software; you can redistribute it and/or | |
| 5 modify it under the terms of the GNU General Public License | |
| 6 as published by the Free Software Foundation; either version 2 | |
| 7 of the License, or (at your option) any later version. | |
| 8 | |
| 9 This program is distributed in the hope that it will be useful, | |
| 10 but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 12 GNU General Public License for more details. | |
| 13 | |
| 14 You should have received a copy of the GNU General Public | |
| 15 License along with this library; if not, write to the Free Software | |
| 16 Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
| 17 */ | |
| 18 | |
| 19 :- module(httpfiles, | |
| 20 [ reply_file/2 | |
| 21 , reply_file/3 | |
| 22 , reply_stream/2 | |
| 23 , reply_stream/3 | |
| 24 , reply_html_page/4 | |
| 25 , write_headers/1 | |
| 26 , mime_type/2 | |
| 27 ]). | |
| 28 | |
| 29 :- use_module(library(http/html_write)). | |
| 30 | |
| 31 :- meta_predicate reply_html_page(+,:,:,+). | |
| 32 | |
| 33 write_headers(Headers) :- maplist(write_header,Headers), nl. | |
| 34 | |
| 35 write_header(length(L)) :- write_header('Content-Length'-L). | |
| 36 write_header(no_ranges) :- write_header('Accept-Ranges'-none). | |
| 37 write_header(stable) :- write_header('Cache-Control'-'max-age=31536000, public'). | |
| 38 write_header(unstable) :- write_header('Cache-Control'-'max-age=0, public'). | |
| 39 write_header(error) :- write_header('Cache-Control'-'max-age=0, private, must-revalidate'). | |
| 40 write_header(html) :- | |
| 41 html_current_option(content_type(ContentType)), | |
| 42 write_header('Content-Type'-ContentType). | |
| 43 write_header(type(Type)) :- | |
| 44 mime_type(Type,MimeType), | |
| 45 write_header('Content-Type'-MimeType). | |
| 46 write_header(cookie(Name,Value,Expires)) :- | |
| 47 format(atom(Cookie),'~w=~w; path=/; Expires=~w',[Name,Value,Expires]), | |
| 48 write_header('Set-Cookie'-Cookie). | |
| 49 write_header(no_cache) :- | |
| 50 maplist( write_header, | |
| 51 [ 'Cache-Control'-'no-cache, no-store, must-revalidate' | |
| 52 , 'Pragma'-'no-cache' | |
| 53 , 'Expires'-'0' | |
| 54 ]). | |
| 55 | |
| 56 write_header(Name-Value) :- | |
| 57 format('~w: ~w~n',[Name,Value]). | |
| 58 | |
| 59 reply_html_page(Style,Head,Body,Headers) :- | |
| 60 phrase(page(Style,Head,Body),Tokens), | |
| 61 write_headers([html|Headers]), | |
| 62 print_html(Tokens). | |
| 63 | |
| 64 reply_file(File,Type) :- reply_file(File,Type,[stable]). | |
| 65 reply_file(File,Type,Headers) :- | |
| 66 write_headers([type(Type)|Headers]), | |
| 67 debug(httpfiles,"Sending ~w with type ~w...",[File,Type]), | |
| 68 setup_call_cleanup( | |
| 69 open(File, read, In, [type(binary)]), | |
| 70 copy_stream_data(In, current_output), | |
| 71 close(In)), | |
| 72 debug(httpfiles,"Finished sending.",[]). | |
| 73 | |
| 74 with_tmp_stream(Enc,File,Str,Goal) :- | |
| 75 setup_call_cleanup( | |
| 76 tmp_file_stream(Enc,File,Str), Goal, | |
| 77 (close(Str,[force(true)]), delete_file(File))). | |
| 78 | |
| 79 reply_stream(In,Type) :- reply_stream(In,Type,[stable]). | |
| 80 reply_stream(In,Type,Headers) :- | |
| 81 ( memberchk(length(Length),Headers), var(Length) | |
| 82 -> debug(httpfiles,"Stream length unknown - buffering to file...",[]), | |
| 83 with_tmp_stream( octet, TmpFile, ToTmp, | |
| 84 ( copy_stream_data(In,ToTmp), close(ToTmp), | |
| 85 size_file(TmpFile,Length), | |
| 86 debug(httpfiles,"Stream length was ~d bytes",[Length]), | |
| 87 reply_file(TmpFile,Type,Headers) | |
| 88 )) | |
| 89 ; write_headers([type(Type)|Headers]), | |
| 90 copy_stream_data(In, current_output) | |
| 91 ), | |
| 92 debug(httpfiles,"Finished sending stream.",[]). | |
| 93 | |
| 94 % debug_stream(S,Label,Prop) :- stream_property(S,Prop), debug(httpfiles,"Stream property (~w): ~w",[Label,Prop]). | |
| 95 | |
| 96 % copy_stream_length(In,Out,Len) :- | |
| 97 % copy_stream_data(In,Out). | |
| 98 % copy_stream_length(In,Out,0,Len). | |
| 99 | |
| 100 % copy_stream_length(In,_,Len,Len) :- at_end_of_stream(In), !. | |
| 101 % copy_stream_length(In,Out,L1,L3) :- | |
| 102 % debug(httpfiles,"Reading...",[]), | |
| 103 % read_pending_input(In,Codes,[]), | |
| 104 % length(Codes,N), L2 is L1+N, | |
| 105 % debug(httpfiles,"Transferring ~d bytes...",[N]), | |
| 106 % format(Out,'~s',[Codes]), | |
| 107 % flush_output(Out), | |
| 108 % copy_stream_length(In,Out,L2,L3). | |
| 109 | |
| 110 mime_type(csv , "text/csv"). | |
| 111 mime_type(ogg , "audio/ogg"). | |
| 112 mime_type(mp3 , "audio/mp3"). | |
| 113 mime_type(aac , "audio/aac"). | |
| 114 mime_type(svg, "image/svg+xml; charset=UTF-8"). | |
| 115 mime_type(pdf, "application/pdf"). | |
| 116 mime_type(eps, "application/postscript"). | |
| 117 mime_type(ps, "application/postscript"). | |
| 118 mime_type(kern, "text/plain; charset=UTF-8"). | |
| 119 mime_type(abc, "text/plain; charset=UTF-8"). % vnd.abc | |
| 120 mime_type(mxml, "text/xml; charset=UTF-8"). | |
| 121 mime_type(lily, "text/plain; charset=UTF-8"). | |
| 122 mime_type(midi, "audio/midi"). | |
| 123 mime_type(png, "image/png"). | |
| 124 mime_type(mp4, "video/mp4"). | |
| 125 mime_type(json, "application/json; charset=UTF-8"). | |
| 126 mime_type(jsonp,"application/javascript; charset=UTF-8"). | |
| 127 | |
| 128 % httpfiles:mime_type(mxml, "application/vnd.recordare.musicxml+xml; charset=UTF-8"). | |
| 129 % httpfiles:mime_type(lily, "text/x-lilypond; charset=UTF-8"). |
