http package (only partially working)
This commit is contained in:
Vítor Santos Costa
146
packages/http/mimepack.pl
Normal file
146
packages/http/mimepack.pl
Normal file
@@ -0,0 +1,146 @@
|
||||
/* $Id$
|
||||
|
||||
Part of SWI-Prolog
|
||||
|
||||
Author: Jan Wielemaker
|
||||
E-mail: jan@swi.psy.uva.nl
|
||||
WWW: http://www.swi-prolog.org
|
||||
Copyright (C): 1985-2002, University of Amsterdam
|
||||
|
||||
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 Lesser General Public
|
||||
License along with this library; if not, write to the Free Software
|
||||
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
|
||||
|
||||
As a special exception, if you link this library with other files,
|
||||
compiled with a Free Software compiler, to produce an executable, this
|
||||
library does not by itself cause the resulting executable to be covered
|
||||
by the GNU General Public License. This exception does not however
|
||||
invalidate any other reasons why the executable file might be covered by
|
||||
the GNU General Public License.
|
||||
*/
|
||||
|
||||
:- module(mime_pack,
|
||||
[ mime_pack/3 % +Input, +Stream, ?Boundary
|
||||
]).
|
||||
:- use_module(mimetype).
|
||||
:- use_module(html_write).
|
||||
|
||||
/* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
|
||||
Simple and partial implementation of MIME encoding. MIME is covered by
|
||||
RFC 2045 which I've read from
|
||||
|
||||
http://www.cis.ohio-state.edu/cgi-bin/rfc/rfc2045.html
|
||||
|
||||
MIME decoding is now arranged through library(mime) from the clib
|
||||
package, based on the external librfc2045 library. Most likely the
|
||||
functionality of this package will be moved to the same library someday.
|
||||
Packing however is a lot simpler then parsing.
|
||||
- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
|
||||
|
||||
%% mime_pack(+Inputs, +Out:stream, ?Boundary) is det.
|
||||
%
|
||||
% Pack a number of inputs into a MIME package using a specified or
|
||||
% generated boundary. The generated boundary consists of the
|
||||
% current time in seconds since the epoch and 10 random
|
||||
% hexadecimal numbers.
|
||||
%
|
||||
% @bug Does not validate that the boundary is unique.
|
||||
|
||||
mime_pack(Inputs, OutputStream, Boundary) :-
|
||||
make_boundary(Inputs, Boundary),
|
||||
pack_list(Inputs, OutputStream, Boundary).
|
||||
|
||||
pack_list([], Out, Boundary) :-
|
||||
format(Out, '--~w--\r\n', [Boundary]).
|
||||
pack_list([H|T], Out, Boundary) :-
|
||||
format(Out, '--~w\r\n', [Boundary]),
|
||||
pack(H, Out),
|
||||
format(Out, '\r\n', []),
|
||||
pack_list(T, Out, Boundary).
|
||||
|
||||
pack(X, _Out) :-
|
||||
var(X), !,
|
||||
throw(error(instantiation_error, _)).
|
||||
pack(Name=Value, Out) :- !,
|
||||
( Value = file(FileName)
|
||||
-> format(Out, 'Content-Disposition: form-data; name="~w"; filename="~w"\r\n',
|
||||
[Name, FileName])
|
||||
; format(Out, 'Content-Disposition: form-data; name="~w"\r\n', [Name])
|
||||
),
|
||||
pack(Value, Out).
|
||||
pack(html(HTML), Out) :-
|
||||
format(Out, 'Content-Type: text/html\r\n\r\n', []),
|
||||
print_html(Out, HTML).
|
||||
pack(file(File), Out) :- !,
|
||||
( file_mime_type(File, Type)
|
||||
-> true
|
||||
; Type = text/plain
|
||||
),
|
||||
format(Out, 'Content-Type: ~w\r\n\r\n', [Type]),
|
||||
( Type = text/_
|
||||
-> OpenOptions = []
|
||||
; OpenOptions = [type(binary)]
|
||||
),
|
||||
open(File, read, In, OpenOptions),
|
||||
copy_stream_data(In, Out),
|
||||
close(In).
|
||||
pack(stream(In, Len), Out) :- !,
|
||||
copy_stream_data(In, Out, Len).
|
||||
pack(stream(In), Out) :- !,
|
||||
copy_stream_data(In, Out).
|
||||
pack(mime(Atts, Data, []), Out) :- !, % mime_parse compatibility
|
||||
write_mime_attributes(Atts, Out),
|
||||
write(Out, Data).
|
||||
pack(mime(_Atts, '', Parts), Out) :-
|
||||
make_boundary(Parts, Boundary),
|
||||
format('Content-type: multipart/mixed; boundary=~w\r\n\r\n',
|
||||
[Boundary]),
|
||||
mime_pack(Parts, Out, Boundary).
|
||||
pack(Atom, Out) :-
|
||||
atomic(Atom), !,
|
||||
format(Out, '\r\n', []),
|
||||
write(Out, Atom).
|
||||
pack(Value, _) :-
|
||||
throw(error(type_error(mime_part, Value), _)).
|
||||
|
||||
write_mime_attributes([], Out) :- !,
|
||||
format(Out, '\r\n', []).
|
||||
write_mime_attributes(Atts, Out) :-
|
||||
select(type(Type), Atts, A1), !,
|
||||
( select(character_set(CharSet), A1, A2)
|
||||
-> format(Out, 'Content-type: ~w; charset=~w\r\n', [Type, CharSet]),
|
||||
write_mime_attributes(A2, Out)
|
||||
; format(Out, 'Content-type: ~w\r\n', [Type]),
|
||||
write_mime_attributes(A1, Out)
|
||||
).
|
||||
write_mime_attributes([_|T], Out) :-
|
||||
write_mime_attributes(T, Out).
|
||||
|
||||
|
||||
%% make_boundary(+Inputs, ?Boundary) is det.
|
||||
%
|
||||
% Generate a boundary. This should check all input sources whether
|
||||
% the boundary is enclosed.
|
||||
|
||||
make_boundary(_, Boundary) :-
|
||||
atomic(Boundary), !.
|
||||
make_boundary(_, Boundary) :-
|
||||
get_time(Now),
|
||||
A is random(1<<16),
|
||||
B is random(1<<16),
|
||||
C is random(1<<16),
|
||||
D is random(1<<16),
|
||||
E is random(1<<16),
|
||||
sformat(Boundary, '------~0f~16r~16r~16r~16r~16r',
|
||||
[Now, A, B, C, D, E]).
|
||||
|
||||
Reference in New Issue
Block a user