Daniel@0: /* Part of DML (Digital Music Laboratory) Daniel@0: Copyright 2014-2015 Samer Abdallah, University of London Daniel@0: Daniel@0: This program is free software; you can redistribute it and/or Daniel@0: modify it under the terms of the GNU General Public License Daniel@0: as published by the Free Software Foundation; either version 2 Daniel@0: of the License, or (at your option) any later version. Daniel@0: Daniel@0: This program is distributed in the hope that it will be useful, Daniel@0: but WITHOUT ANY WARRANTY; without even the implied warranty of Daniel@0: MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the Daniel@0: GNU General Public License for more details. Daniel@0: Daniel@0: You should have received a copy of the GNU General Public Daniel@0: License along with this library; if not, write to the Free Software Daniel@0: Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA Daniel@0: */ Daniel@0: Daniel@0: :- module(httpfiles, Daniel@0: [ reply_file/2 Daniel@0: , reply_file/3 Daniel@0: , reply_stream/2 Daniel@0: , reply_stream/3 Daniel@0: , reply_html_page/4 Daniel@0: , write_headers/1 Daniel@0: , mime_type/2 Daniel@0: ]). Daniel@0: Daniel@0: :- use_module(library(http/html_write)). Daniel@0: Daniel@0: :- meta_predicate reply_html_page(+,:,:,+). Daniel@0: Daniel@0: write_headers(Headers) :- maplist(write_header,Headers), nl. Daniel@0: Daniel@0: write_header(length(L)) :- write_header('Content-Length'-L). Daniel@0: write_header(no_ranges) :- write_header('Accept-Ranges'-none). Daniel@0: write_header(stable) :- write_header('Cache-Control'-'max-age=31536000, public'). Daniel@0: write_header(unstable) :- write_header('Cache-Control'-'max-age=0, public'). Daniel@0: write_header(error) :- write_header('Cache-Control'-'max-age=0, private, must-revalidate'). Daniel@0: write_header(html) :- Daniel@0: html_current_option(content_type(ContentType)), Daniel@0: write_header('Content-Type'-ContentType). Daniel@0: write_header(type(Type)) :- Daniel@0: mime_type(Type,MimeType), Daniel@0: write_header('Content-Type'-MimeType). Daniel@0: write_header(cookie(Name,Value,Expires)) :- Daniel@0: format(atom(Cookie),'~w=~w; path=/; Expires=~w',[Name,Value,Expires]), Daniel@0: write_header('Set-Cookie'-Cookie). Daniel@0: write_header(no_cache) :- Daniel@0: maplist( write_header, Daniel@0: [ 'Cache-Control'-'no-cache, no-store, must-revalidate' Daniel@0: , 'Pragma'-'no-cache' Daniel@0: , 'Expires'-'0' Daniel@0: ]). Daniel@0: Daniel@0: write_header(Name-Value) :- Daniel@0: format('~w: ~w~n',[Name,Value]). Daniel@0: Daniel@0: reply_html_page(Style,Head,Body,Headers) :- Daniel@0: phrase(page(Style,Head,Body),Tokens), Daniel@0: write_headers([html|Headers]), Daniel@0: print_html(Tokens). Daniel@0: Daniel@0: reply_file(File,Type) :- reply_file(File,Type,[stable]). Daniel@0: reply_file(File,Type,Headers) :- Daniel@0: write_headers([type(Type)|Headers]), Daniel@0: debug(httpfiles,"Sending ~w with type ~w...",[File,Type]), Daniel@0: setup_call_cleanup( Daniel@0: open(File, read, In, [type(binary)]), Daniel@0: copy_stream_data(In, current_output), Daniel@0: close(In)), Daniel@0: debug(httpfiles,"Finished sending.",[]). Daniel@0: Daniel@0: with_tmp_stream(Enc,File,Str,Goal) :- Daniel@0: setup_call_cleanup( Daniel@0: tmp_file_stream(Enc,File,Str), Goal, Daniel@0: (close(Str,[force(true)]), delete_file(File))). Daniel@0: Daniel@0: reply_stream(In,Type) :- reply_stream(In,Type,[stable]). Daniel@0: reply_stream(In,Type,Headers) :- Daniel@0: ( memberchk(length(Length),Headers), var(Length) Daniel@0: -> debug(httpfiles,"Stream length unknown - buffering to file...",[]), Daniel@0: with_tmp_stream( octet, TmpFile, ToTmp, Daniel@0: ( copy_stream_data(In,ToTmp), close(ToTmp), Daniel@0: size_file(TmpFile,Length), Daniel@0: debug(httpfiles,"Stream length was ~d bytes",[Length]), Daniel@0: reply_file(TmpFile,Type,Headers) Daniel@0: )) Daniel@0: ; write_headers([type(Type)|Headers]), Daniel@0: copy_stream_data(In, current_output) Daniel@0: ), Daniel@0: debug(httpfiles,"Finished sending stream.",[]). Daniel@0: Daniel@0: % debug_stream(S,Label,Prop) :- stream_property(S,Prop), debug(httpfiles,"Stream property (~w): ~w",[Label,Prop]). Daniel@0: Daniel@0: % copy_stream_length(In,Out,Len) :- Daniel@0: % copy_stream_data(In,Out). Daniel@0: % copy_stream_length(In,Out,0,Len). Daniel@0: Daniel@0: % copy_stream_length(In,_,Len,Len) :- at_end_of_stream(In), !. Daniel@0: % copy_stream_length(In,Out,L1,L3) :- Daniel@0: % debug(httpfiles,"Reading...",[]), Daniel@0: % read_pending_input(In,Codes,[]), Daniel@0: % length(Codes,N), L2 is L1+N, Daniel@0: % debug(httpfiles,"Transferring ~d bytes...",[N]), Daniel@0: % format(Out,'~s',[Codes]), Daniel@0: % flush_output(Out), Daniel@0: % copy_stream_length(In,Out,L2,L3). Daniel@0: Daniel@0: mime_type(csv , "text/csv"). Daniel@0: mime_type(ogg , "audio/ogg"). Daniel@0: mime_type(mp3 , "audio/mp3"). Daniel@0: mime_type(aac , "audio/aac"). Daniel@0: mime_type(svg, "image/svg+xml; charset=UTF-8"). Daniel@0: mime_type(pdf, "application/pdf"). Daniel@0: mime_type(eps, "application/postscript"). Daniel@0: mime_type(ps, "application/postscript"). Daniel@0: mime_type(kern, "text/plain; charset=UTF-8"). Daniel@0: mime_type(abc, "text/plain; charset=UTF-8"). % vnd.abc Daniel@0: mime_type(mxml, "text/xml; charset=UTF-8"). Daniel@0: mime_type(lily, "text/plain; charset=UTF-8"). Daniel@0: mime_type(midi, "audio/midi"). Daniel@0: mime_type(png, "image/png"). Daniel@0: mime_type(mp4, "video/mp4"). Daniel@0: mime_type(json, "application/json; charset=UTF-8"). Daniel@0: mime_type(jsonp,"application/javascript; charset=UTF-8"). Daniel@0: Daniel@0: % httpfiles:mime_type(mxml, "application/vnd.recordare.musicxml+xml; charset=UTF-8"). Daniel@0: % httpfiles:mime_type(lily, "text/x-lilypond; charset=UTF-8").