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"). |