view cpack/dml/lib/httpfiles.pl @ 0:718306e29690 tip

commiting public release

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