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