35
36:- module(http_header,
37 [ http_read_request/2, 38 http_read_reply_header/2, 39 http_reply/2, 40 http_reply/3, 41 http_reply/4, 42 http_reply/5, 43 44 http_reply/6, 45 46 http_reply_header/3, 47 http_status_reply/4, 48 http_status_reply/5, 49 50
51 http_timestamp/2, 52
53 http_post_data/3, 54
55 http_read_header/2, 56 http_parse_header/2, 57 http_parse_header_value/3, 58 http_join_headers/3, 59 http_update_encoding/3, 60 http_update_connection/4, 61 http_update_transfer/4 62 ]). 63:- autoload(html_write,
64 [ print_html/2, print_html/1, page/4, html/3,
65 html_print_length/2
66 ]). 67:- autoload(http_exception,[map_exception_to_http_status/4]). 68:- autoload(mimepack,[mime_pack/3]). 69:- autoload(mimetype,[file_mime_type/2]). 70:- autoload(library(apply),[maplist/2]). 71:- autoload(library(base64),[base64/2]). 72:- autoload(library(debug),[debug/3,debugging/1]). 73:- autoload(library(error),[syntax_error/1,domain_error/2]). 74:- autoload(library(lists),[append/3,member/2,select/3,delete/3]). 75:- autoload(library(memfile),
76 [ new_memory_file/1, open_memory_file/3,
77 free_memory_file/1, open_memory_file/4,
78 size_memory_file/3
79 ]). 80:- autoload(library(option),[option/3,option/2]). 81:- autoload(library(pairs),[pairs_values/2]). 82:- autoload(library(readutil),
83 [read_line_to_codes/2,read_line_to_codes/3]). 84:- autoload(library(sgml_write),[xml_write/3]). 85:- autoload(library(socket),[gethostname/1]). 86:- autoload(library(uri),
87 [ uri_components/2, uri_data/3, uri_encoded/3, uri_query_components/2
88 ]). 89:- autoload(library(url),[parse_url_search/2]). 90:- autoload(library(dcg/basics),
91 [ integer/3, atom/3, whites/2, blanks_to_nl/2, string/3,
92 number/3, blanks/2, float/3, nonblanks/3, eos/2
93 ]). 94:- use_module(library(settings),[setting/4,setting/2]). 95
96:- multifile
97 http:status_page/3, 98 http:status_reply/3, 99 http:serialize_reply/2, 100 http:post_data_hook/3, 101 http:mime_type_encoding/2. 102
104
105:- setting(http:chunked_transfer, oneof([never,on_request,if_possible]),
106 on_request, 'When to use Transfer-Encoding: Chunked'). 107
108
115
116:- discontiguous
117 term_expansion/2. 118
119
120 123
129
130http_read_request(In, Request) :-
131 catch(read_line_to_codes(In, Codes), E, true),
132 ( var(E)
133 -> ( Codes == end_of_file
134 -> debug(http(header), 'end-of-file', []),
135 Request = end_of_file
136 ; debug(http(header), 'First line: ~s', [Codes]),
137 Request = [input(In)|Request1],
138 phrase(request(In, Request1), Codes),
139 ( Request1 = [unknown(Text)|_]
140 -> string_codes(S, Text),
141 syntax_error(http_request(S))
142 ; true
143 )
144 )
145 ; ( debugging(http(request))
146 -> message_to_string(E, Msg),
147 debug(http(request), "Exception reading 1st line: ~s", [Msg])
148 ; true
149 ),
150 Request = end_of_file
151 ).
152
153
158
(In, [input(In)|Reply]) :-
160 read_line_to_codes(In, Codes),
161 ( Codes == end_of_file
162 -> debug(http(header), 'end-of-file', []),
163 throw(error(syntax(http_reply_header, end_of_file), _))
164 ; debug(http(header), 'First line: ~s~n', [Codes]),
165 ( phrase(reply(In, Reply), Codes)
166 -> true
167 ; atom_codes(Header, Codes),
168 syntax_error(http_reply_header(Header))
169 )
170 ).
171
172
173 176
223
224http_reply(What, Out) :-
225 http_reply(What, Out, [connection(close)], _).
226
227http_reply(Data, Out, HdrExtra) :-
228 http_reply(Data, Out, HdrExtra, _Code).
229
230http_reply(Data, Out, HdrExtra, Code) :-
231 http_reply(Data, Out, HdrExtra, [], Code).
232
233http_reply(Data, Out, HdrExtra, Context, Code) :-
234 http_reply(Data, Out, HdrExtra, Context, [method(get)], Code).
235
236http_reply(Data, Out, HdrExtra, _Context, Request, Code) :-
237 byte_count(Out, C0),
238 memberchk(method(Method), Request),
239 catch(http_reply_data(Data, Out, HdrExtra, Method, Code), E, true),
240 !,
241 ( var(E)
242 -> true
243 ; ( E = error(io_error(write,_), _)
244 ; E = error(socket_error(_,_), _)
245 )
246 -> byte_count(Out, C1),
247 Sent is C1 - C0,
248 throw(error(http_write_short(Data, Sent), _))
249 ; E = error(timeout_error(write, _), _)
250 -> throw(E)
251 ; map_exception_to_http_status(E, Status, NewHdr, NewContext),
252 http_status_reply(Status, Out, NewHdr, NewContext, Request, Code)
253 ).
254http_reply(Status, Out, HdrExtra, Context, Request, Code) :-
255 http_status_reply(Status, Out, HdrExtra, Context, Request, Code).
256
257:- meta_predicate
258 if_no_head(0, +). 259
266
267http_reply_data(Data, Out, HdrExtra, Method, Code) :-
268 http_reply_data_(Data, Out, HdrExtra, Method, Code),
269 flush_output(Out).
270
271http_reply_data_(html(HTML), Out, HdrExtra, Method, Code) :-
272 !,
273 phrase(reply_header(html(HTML), HdrExtra, Code), Header),
274 format(Out, '~s', [Header]),
275 if_no_head(print_html(Out, HTML), Method).
276http_reply_data_(file(Type, File), Out, HdrExtra, Method, Code) :-
277 !,
278 phrase(reply_header(file(Type, File), HdrExtra, Code), Header),
279 reply_file(Out, File, Header, Method).
280http_reply_data_(gzip_file(Type, File), Out, HdrExtra, Method, Code) :-
281 !,
282 phrase(reply_header(gzip_file(Type, File), HdrExtra, Code), Header),
283 reply_file(Out, File, Header, Method).
284http_reply_data_(file(Type, File, Range), Out, HdrExtra, Method, Code) :-
285 !,
286 phrase(reply_header(file(Type, File, Range), HdrExtra, Code), Header),
287 reply_file_range(Out, File, Header, Range, Method).
288http_reply_data_(tmp_file(Type, File), Out, HdrExtra, Method, Code) :-
289 !,
290 phrase(reply_header(tmp_file(Type, File), HdrExtra, Code), Header),
291 reply_file(Out, File, Header, Method).
292http_reply_data_(bytes(Type, Bytes), Out, HdrExtra, Method, Code) :-
293 !,
294 phrase(reply_header(bytes(Type, Bytes), HdrExtra, Code), Header),
295 format(Out, '~s', [Header]),
296 if_no_head(format(Out, '~s', [Bytes]), Method).
297http_reply_data_(stream(In, Len), Out, HdrExtra, Method, Code) :-
298 !,
299 phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header),
300 copy_stream(Out, In, Header, Method, 0, end).
301http_reply_data_(cgi_stream(In, Len), Out, HdrExtra, Method, Code) :-
302 !,
303 http_read_header(In, CgiHeader),
304 seek(In, 0, current, Pos),
305 Size is Len - Pos,
306 http_join_headers(HdrExtra, CgiHeader, Hdr2),
307 phrase(reply_header(cgi_data(Size), Hdr2, Code), Header),
308 copy_stream(Out, In, Header, Method, 0, end).
309
310if_no_head(_, head) :-
311 !.
312if_no_head(Goal, _) :-
313 call(Goal).
314
315reply_file(Out, _File, Header, head) :-
316 !,
317 format(Out, '~s', [Header]).
318reply_file(Out, File, Header, _) :-
319 setup_call_cleanup(
320 open(File, read, In, [type(binary)]),
321 copy_stream(Out, In, Header, 0, end),
322 close(In)).
323
324reply_file_range(Out, _File, Header, _Range, head) :-
325 !,
326 format(Out, '~s', [Header]).
327reply_file_range(Out, File, Header, bytes(From, To), _) :-
328 setup_call_cleanup(
329 open(File, read, In, [type(binary)]),
330 copy_stream(Out, In, Header, From, To),
331 close(In)).
332
333copy_stream(Out, _, Header, head, _, _) :-
334 !,
335 format(Out, '~s', [Header]).
336copy_stream(Out, In, Header, _, From, To) :-
337 copy_stream(Out, In, Header, From, To).
338
339copy_stream(Out, In, Header, From, To) :-
340 ( From == 0
341 -> true
342 ; seek(In, From, bof, _)
343 ),
344 peek_byte(In, _),
345 format(Out, '~s', [Header]),
346 ( To == end
347 -> copy_stream_data(In, Out)
348 ; Len is To - From,
349 copy_stream_data(In, Out, Len)
350 ).
351
352
383
384http_status_reply(Status, Out, Options) :-
385 _{header:HdrExtra, context:Context, code:Code, method:Method} :< Options,
386 http_status_reply(Status, Out, HdrExtra, Context, [method(Method)], Code).
387
388http_status_reply(Status, Out, HdrExtra, Code) :-
389 http_status_reply(Status, Out, HdrExtra, [], Code).
390
391http_status_reply(Status, Out, HdrExtra, Context, Code) :-
392 http_status_reply(Status, Out, HdrExtra, Context, [method(get)], Code).
393
394http_status_reply(Status, Out, HdrExtra, Context, Request, Code) :-
395 option(method(Method), Request, get),
396 parsed_accept(Request, Accept),
397 status_reply_flush(Status, Out,
398 _{ context: Context,
399 method: Method,
400 code: Code,
401 accept: Accept,
402 header: HdrExtra
403 }).
404
405parsed_accept(Request, Accept) :-
406 memberchk(accept(Accept0), Request),
407 http_parse_header_value(accept, Accept0, Accept1),
408 !,
409 Accept = Accept1.
410parsed_accept(_, [ media(text/html, [], 0.1, []),
411 media(_, [], 0.01, [])
412 ]).
413
414status_reply_flush(Status, Out, Options) :-
415 status_reply(Status, Out, Options),
416 !,
417 flush_output(Out).
418
429
431status_reply(no_content, Out, Options) :-
432 !,
433 phrase(reply_header(status(no_content), Options), Header),
434 format(Out, '~s', [Header]).
435status_reply(switching_protocols(_Goal,SwitchOptions), Out, Options) :-
436 !,
437 ( option(headers(Extra1), SwitchOptions)
438 -> true
439 ; option(header(Extra1), SwitchOptions, [])
440 ),
441 http_join_headers(Options.header, Extra1, HdrExtra),
442 phrase(reply_header(status(switching_protocols),
443 Options.put(header,HdrExtra)), Header),
444 format(Out, '~s', [Header]).
445status_reply(authorise(basic, ''), Out, Options) :-
446 !,
447 status_reply(authorise(basic), Out, Options).
448status_reply(authorise(basic, Realm), Out, Options) :-
449 !,
450 status_reply(authorise(basic(Realm)), Out, Options).
451status_reply(not_modified, Out, Options) :-
452 !,
453 phrase(reply_header(status(not_modified), Options), Header),
454 format(Out, '~s', [Header]).
456status_reply(busy, Out, Options) :-
457 status_reply(service_unavailable(busy), Out, Options).
458status_reply(unavailable(Why), Out, Options) :-
459 status_reply(service_unavailable(Why), Out, Options).
460status_reply(resource_error(Why), Out, Options) :-
461 status_reply(service_unavailable(Why), Out, Options).
463status_reply(Status, Out, Options) :-
464 status_has_content(Status),
465 status_page_hook(Status, Reply, Options),
466 serialize_body(Reply, Body),
467 Status =.. List,
468 append(List, [Body], ExList),
469 ExStatus =.. ExList,
470 phrase(reply_header(ExStatus, Options), Header),
471 format(Out, '~s', [Header]),
472 reply_status_body(Out, Body, Options).
473
478
479status_has_content(created(_Location)).
480status_has_content(moved(_To)).
481status_has_content(moved_temporary(_To)).
482status_has_content(gone(_URL)).
483status_has_content(see_other(_To)).
484status_has_content(bad_request(_ErrorTerm)).
485status_has_content(authorise(_Method)).
486status_has_content(forbidden(_URL)).
487status_has_content(not_found(_URL)).
488status_has_content(method_not_allowed(_Method, _URL)).
489status_has_content(not_acceptable(_Why)).
490status_has_content(server_error(_ErrorTerm)).
491status_has_content(service_unavailable(_Why)).
492
501
502serialize_body(Reply, Body) :-
503 http:serialize_reply(Reply, Body),
504 !.
505serialize_body(html_tokens(Tokens), body(text/html, utf8, Content)) :-
506 !,
507 with_output_to(string(Content), print_html(Tokens)).
508serialize_body(Reply, Reply) :-
509 Reply = body(_,_,_),
510 !.
511serialize_body(Reply, _) :-
512 domain_error(http_reply_body, Reply).
513
514reply_status_body(_, _, Options) :-
515 Options.method == head,
516 !.
517reply_status_body(Out, body(_Type, Encoding, Content), _Options) :-
518 ( Encoding == octet
519 -> format(Out, '~s', [Content])
520 ; setup_call_cleanup(
521 set_stream(Out, encoding(Encoding)),
522 format(Out, '~s', [Content]),
523 set_stream(Out, encoding(octet)))
524 ).
525
535
550
551status_page_hook(Term, Reply, Options) :-
552 Context = Options.context,
553 functor(Term, Name, _),
554 status_number_fact(Name, Code),
555 ( Options.code = Code,
556 http:status_reply(Term, Reply, Options)
557 ; http:status_page(Term, Context, HTML),
558 Reply = html_tokens(HTML)
559 ; http:status_page(Code, Context, HTML), 560 Reply = html_tokens(HTML)
561 ),
562 !.
563status_page_hook(created(Location), html_tokens(HTML), _Options) :-
564 phrase(page([ title('201 Created')
565 ],
566 [ h1('Created'),
567 p(['The document was created ',
568 a(href(Location), ' Here')
569 ]),
570 \address
571 ]),
572 HTML).
573status_page_hook(moved(To), html_tokens(HTML), _Options) :-
574 phrase(page([ title('301 Moved Permanently')
575 ],
576 [ h1('Moved Permanently'),
577 p(['The document has moved ',
578 a(href(To), ' Here')
579 ]),
580 \address
581 ]),
582 HTML).
583status_page_hook(moved_temporary(To), html_tokens(HTML), _Options) :-
584 phrase(page([ title('302 Moved Temporary')
585 ],
586 [ h1('Moved Temporary'),
587 p(['The document is currently ',
588 a(href(To), ' Here')
589 ]),
590 \address
591 ]),
592 HTML).
593status_page_hook(gone(URL), html_tokens(HTML), _Options) :-
594 phrase(page([ title('410 Resource Gone')
595 ],
596 [ h1('Resource Gone'),
597 p(['The document has been removed ',
598 a(href(URL), ' from here')
599 ]),
600 \address
601 ]),
602 HTML).
603status_page_hook(see_other(To), html_tokens(HTML), _Options) :-
604 phrase(page([ title('303 See Other')
605 ],
606 [ h1('See Other'),
607 p(['See other document ',
608 a(href(To), ' Here')
609 ]),
610 \address
611 ]),
612 HTML).
613status_page_hook(bad_request(ErrorTerm), html_tokens(HTML), _Options) :-
614 '$messages':translate_message(ErrorTerm, Lines, []),
615 phrase(page([ title('400 Bad Request')
616 ],
617 [ h1('Bad Request'),
618 p(\html_message_lines(Lines)),
619 \address
620 ]),
621 HTML).
622status_page_hook(authorise(_Method), html_tokens(HTML), _Options):-
623 phrase(page([ title('401 Authorization Required')
624 ],
625 [ h1('Authorization Required'),
626 p(['This server could not verify that you ',
627 'are authorized to access the document ',
628 'requested. Either you supplied the wrong ',
629 'credentials (e.g., bad password), or your ',
630 'browser doesn\'t understand how to supply ',
631 'the credentials required.'
632 ]),
633 \address
634 ]),
635 HTML).
636status_page_hook(forbidden(URL), html_tokens(HTML), _Options) :-
637 phrase(page([ title('403 Forbidden')
638 ],
639 [ h1('Forbidden'),
640 p(['You don\'t have permission to access ', URL,
641 ' on this server'
642 ]),
643 \address
644 ]),
645 HTML).
646status_page_hook(not_found(URL), html_tokens(HTML), _Options) :-
647 phrase(page([ title('404 Not Found')
648 ],
649 [ h1('Not Found'),
650 p(['The requested URL ', tt(URL),
651 ' was not found on this server'
652 ]),
653 \address
654 ]),
655 HTML).
656status_page_hook(method_not_allowed(Method,URL), html_tokens(HTML), _Options) :-
657 upcase_atom(Method, UMethod),
658 phrase(page([ title('405 Method not allowed')
659 ],
660 [ h1('Method not allowed'),
661 p(['The requested URL ', tt(URL),
662 ' does not support method ', tt(UMethod), '.'
663 ]),
664 \address
665 ]),
666 HTML).
667status_page_hook(not_acceptable(WhyHTML), html_tokens(HTML), _Options) :-
668 phrase(page([ title('406 Not Acceptable')
669 ],
670 [ h1('Not Acceptable'),
671 WhyHTML,
672 \address
673 ]),
674 HTML).
675status_page_hook(server_error(ErrorTerm), html_tokens(HTML), _Options) :-
676 '$messages':translate_message(ErrorTerm, Lines, []),
677 phrase(page([ title('500 Internal server error')
678 ],
679 [ h1('Internal server error'),
680 p(\html_message_lines(Lines)),
681 \address
682 ]),
683 HTML).
684status_page_hook(service_unavailable(Why), html_tokens(HTML), _Options) :-
685 phrase(page([ title('503 Service Unavailable')
686 ],
687 [ h1('Service Unavailable'),
688 \unavailable(Why),
689 \address
690 ]),
691 HTML).
692
693unavailable(busy) -->
694 html(p(['The server is temporarily out of resources, ',
695 'please try again later'])).
696unavailable(error(Formal,Context)) -->
697 { '$messages':translate_message(error(Formal,Context), Lines, []) },
698 html_message_lines(Lines).
699unavailable(HTML) -->
700 html(HTML).
701
702html_message_lines([]) -->
703 [].
704html_message_lines([nl|T]) -->
705 !,
706 html([br([])]),
707 html_message_lines(T).
708html_message_lines([flush]) -->
709 [].
710html_message_lines([Fmt-Args|T]) -->
711 !,
712 { format(string(S), Fmt, Args)
713 },
714 html([S]),
715 html_message_lines(T).
716html_message_lines([Fmt|T]) -->
717 !,
718 { format(string(S), Fmt, [])
719 },
720 html([S]),
721 html_message_lines(T).
722
727
([], H, H).
729http_join_headers([H|T], Hdr0, Hdr) :-
730 functor(H, N, A),
731 functor(H2, N, A),
732 member(H2, Hdr0),
733 !,
734 http_join_headers(T, Hdr0, Hdr).
735http_join_headers([H|T], Hdr0, [H|Hdr]) :-
736 http_join_headers(T, Hdr0, Hdr).
737
738
747
748http_update_encoding(Header0, utf8, [content_type(Type)|Header]) :-
749 select(content_type(Type0), Header0, Header),
750 sub_atom(Type0, 0, _, _, 'text/'),
751 !,
752 ( sub_atom(Type0, S, _, _, ';')
753 -> sub_atom(Type0, 0, S, _, B)
754 ; B = Type0
755 ),
756 atom_concat(B, '; charset=UTF-8', Type).
757http_update_encoding(Header, Encoding, Header) :-
758 memberchk(content_type(Type), Header),
759 ( ( sub_atom(Type, _, _, _, 'UTF-8')
760 ; sub_atom(Type, _, _, _, 'utf-8')
761 )
762 -> Encoding = utf8
763 ; http:mime_type_encoding(Type, Encoding)
764 -> true
765 ; mime_type_encoding(Type, Encoding)
766 ).
767http_update_encoding(Header, octet, Header).
768
773
774mime_type_encoding('application/json', utf8).
775mime_type_encoding('application/jsonrequest', utf8).
776mime_type_encoding('application/x-prolog', utf8).
777mime_type_encoding('application/n-quads', utf8).
778mime_type_encoding('application/n-triples', utf8).
779mime_type_encoding('application/sparql-query', utf8).
780mime_type_encoding('application/trig', utf8).
781
789
790
795
796http_update_connection(CgiHeader, Request, Connect,
797 [connection(Connect)|Rest]) :-
798 select(connection(CgiConn), CgiHeader, Rest),
799 !,
800 connection(Request, ReqConnection),
801 join_connection(ReqConnection, CgiConn, Connect).
802http_update_connection(CgiHeader, Request, Connect,
803 [connection(Connect)|CgiHeader]) :-
804 connection(Request, Connect).
805
806join_connection(Keep1, Keep2, Connection) :-
807 ( downcase_atom(Keep1, 'keep-alive'),
808 downcase_atom(Keep2, 'keep-alive')
809 -> Connection = 'Keep-Alive'
810 ; Connection = close
811 ).
812
813
817
818connection(Header, Close) :-
819 ( memberchk(connection(Connection), Header)
820 -> Close = Connection
821 ; memberchk(http_version(1-X), Header),
822 X >= 1
823 -> Close = 'Keep-Alive'
824 ; Close = close
825 ).
826
827
843
844http_update_transfer(Request, CgiHeader, Transfer, Header) :-
845 setting(http:chunked_transfer, When),
846 http_update_transfer(When, Request, CgiHeader, Transfer, Header).
847
848http_update_transfer(never, _, CgiHeader, none, Header) :-
849 !,
850 delete(CgiHeader, transfer_encoding(_), Header).
851http_update_transfer(_, _, CgiHeader, none, Header) :-
852 memberchk(location(_), CgiHeader),
853 !,
854 delete(CgiHeader, transfer_encoding(_), Header).
855http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
856 select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
857 !,
858 transfer(Request, ReqConnection),
859 join_transfer(ReqConnection, CgiTransfer, Transfer),
860 ( Transfer == none
861 -> Header = Rest
862 ; Header = [transfer_encoding(Transfer)|Rest]
863 ).
864http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
865 transfer(Request, Transfer),
866 Transfer \== none,
867 !,
868 Header = [transfer_encoding(Transfer)|CgiHeader].
869http_update_transfer(_, _, CgiHeader, none, CgiHeader).
870
871join_transfer(chunked, chunked, chunked) :- !.
872join_transfer(_, _, none).
873
874
878
879transfer(Header, Transfer) :-
880 ( memberchk(transfer_encoding(Transfer0), Header)
881 -> Transfer = Transfer0
882 ; memberchk(http_version(1-X), Header),
883 X >= 1
884 -> Transfer = chunked
885 ; Transfer = none
886 ).
887
888
894
895content_length_in_encoding(Enc, Stream, Bytes) :-
896 stream_property(Stream, position(Here)),
897 setup_call_cleanup(
898 open_null_stream(Out),
899 ( set_stream(Out, encoding(Enc)),
900 catch(copy_stream_data(Stream, Out), _, fail),
901 flush_output(Out),
902 byte_count(Out, Bytes)
903 ),
904 ( close(Out, [force(true)]),
905 set_stream_position(Stream, Here)
906 )).
907
908
909 912
1003
1004http_post_data(Data, Out, HdrExtra) :-
1005 http:post_data_hook(Data, Out, HdrExtra),
1006 !.
1007http_post_data(html(HTML), Out, HdrExtra) :-
1008 !,
1009 phrase(post_header(html(HTML), HdrExtra), Header),
1010 format(Out, '~s', [Header]),
1011 print_html(Out, HTML).
1012http_post_data(xml(XML), Out, HdrExtra) :-
1013 !,
1014 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
1015http_post_data(xml(Type, XML), Out, HdrExtra) :-
1016 !,
1017 http_post_data(xml(Type, XML, []), Out, HdrExtra).
1018http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
1019 !,
1020 setup_call_cleanup(
1021 new_memory_file(MemFile),
1022 ( setup_call_cleanup(
1023 open_memory_file(MemFile, write, MemOut),
1024 xml_write(MemOut, XML, Options),
1025 close(MemOut)),
1026 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
1027 ),
1028 free_memory_file(MemFile)).
1029http_post_data(file(File), Out, HdrExtra) :-
1030 !,
1031 ( file_mime_type(File, Type)
1032 -> true
1033 ; Type = text/plain
1034 ),
1035 http_post_data(file(Type, File), Out, HdrExtra).
1036http_post_data(file(Type, File), Out, HdrExtra) :-
1037 !,
1038 phrase(post_header(file(Type, File), HdrExtra), Header),
1039 format(Out, '~s', [Header]),
1040 setup_call_cleanup(
1041 open(File, read, In, [type(binary)]),
1042 copy_stream_data(In, Out),
1043 close(In)).
1044http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
1045 !,
1046 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1047 format(Out, '~s', [Header]),
1048 setup_call_cleanup(
1049 open_memory_file(Handle, read, In, [encoding(octet)]),
1050 copy_stream_data(In, Out),
1051 close(In)).
1052http_post_data(codes(Codes), Out, HdrExtra) :-
1053 !,
1054 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1055http_post_data(codes(Type, Codes), Out, HdrExtra) :-
1056 !,
1057 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1058 format(Out, '~s', [Header]),
1059 setup_call_cleanup(
1060 set_stream(Out, encoding(utf8)),
1061 format(Out, '~s', [Codes]),
1062 set_stream(Out, encoding(octet))).
1063http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
1064 !,
1065 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1066 format(Out, '~s~s', [Header, Bytes]).
1067http_post_data(atom(Atom), Out, HdrExtra) :-
1068 !,
1069 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1070http_post_data(atom(Type, Atom), Out, HdrExtra) :-
1071 !,
1072 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1073 format(Out, '~s', [Header]),
1074 setup_call_cleanup(
1075 set_stream(Out, encoding(utf8)),
1076 write(Out, Atom),
1077 set_stream(Out, encoding(octet))).
1078http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
1079 !,
1080 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1081 http_post_data(cgi_stream(In), Out, HdrExtra).
1082http_post_data(cgi_stream(In), Out, HdrExtra) :-
1083 !,
1084 http_read_header(In, Header0),
1085 http_update_encoding(Header0, Encoding, Header),
1086 content_length_in_encoding(Encoding, In, Size),
1087 http_join_headers(HdrExtra, Header, Hdr2),
1088 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1089 format(Out, '~s', [HeaderText]),
1090 setup_call_cleanup(
1091 set_stream(Out, encoding(Encoding)),
1092 copy_stream_data(In, Out),
1093 set_stream(Out, encoding(octet))).
1094http_post_data(form(Fields), Out, HdrExtra) :-
1095 !,
1096 parse_url_search(Codes, Fields),
1097 length(Codes, Size),
1098 http_join_headers(HdrExtra,
1099 [ content_type('application/x-www-form-urlencoded')
1100 ], Header),
1101 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1102 format(Out, '~s', [HeaderChars]),
1103 format(Out, '~s', [Codes]).
1104http_post_data(form_data(Data), Out, HdrExtra) :-
1105 !,
1106 setup_call_cleanup(
1107 new_memory_file(MemFile),
1108 ( setup_call_cleanup(
1109 open_memory_file(MemFile, write, MimeOut),
1110 mime_pack(Data, MimeOut, Boundary),
1111 close(MimeOut)),
1112 size_memory_file(MemFile, Size, octet),
1113 format(string(ContentType),
1114 'multipart/form-data; boundary=~w', [Boundary]),
1115 http_join_headers(HdrExtra,
1116 [ mime_version('1.0'),
1117 content_type(ContentType)
1118 ], Header),
1119 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1120 format(Out, '~s', [HeaderChars]),
1121 setup_call_cleanup(
1122 open_memory_file(MemFile, read, In, [encoding(octet)]),
1123 copy_stream_data(In, Out),
1124 close(In))
1125 ),
1126 free_memory_file(MemFile)).
1127http_post_data(List, Out, HdrExtra) :- 1128 is_list(List),
1129 !,
1130 setup_call_cleanup(
1131 new_memory_file(MemFile),
1132 ( setup_call_cleanup(
1133 open_memory_file(MemFile, write, MimeOut),
1134 mime_pack(List, MimeOut, Boundary),
1135 close(MimeOut)),
1136 size_memory_file(MemFile, Size, octet),
1137 format(string(ContentType),
1138 'multipart/mixed; boundary=~w', [Boundary]),
1139 http_join_headers(HdrExtra,
1140 [ mime_version('1.0'),
1141 content_type(ContentType)
1142 ], Header),
1143 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1144 format(Out, '~s', [HeaderChars]),
1145 setup_call_cleanup(
1146 open_memory_file(MemFile, read, In, [encoding(octet)]),
1147 copy_stream_data(In, Out),
1148 close(In))
1149 ),
1150 free_memory_file(MemFile)).
1151
1156
(html(Tokens), HdrExtra) -->
1158 header_fields(HdrExtra, Len),
1159 content_length(html(Tokens), Len),
1160 content_type(text/html),
1161 "\r\n".
1162post_header(file(Type, File), HdrExtra) -->
1163 header_fields(HdrExtra, Len),
1164 content_length(file(File), Len),
1165 content_type(Type),
1166 "\r\n".
1167post_header(memory_file(Type, File), HdrExtra) -->
1168 header_fields(HdrExtra, Len),
1169 content_length(memory_file(File), Len),
1170 content_type(Type),
1171 "\r\n".
1172post_header(cgi_data(Size), HdrExtra) -->
1173 header_fields(HdrExtra, Len),
1174 content_length(Size, Len),
1175 "\r\n".
1176post_header(codes(Type, Codes), HdrExtra) -->
1177 header_fields(HdrExtra, Len),
1178 content_length(codes(Codes, utf8), Len),
1179 content_type(Type, utf8),
1180 "\r\n".
1181post_header(bytes(Type, Bytes), HdrExtra) -->
1182 header_fields(HdrExtra, Len),
1183 content_length(bytes(Bytes), Len),
1184 content_type(Type),
1185 "\r\n".
1186post_header(atom(Type, Atom), HdrExtra) -->
1187 header_fields(HdrExtra, Len),
1188 content_length(atom(Atom, utf8), Len),
1189 content_type(Type, utf8),
1190 "\r\n".
1191
1192
1193 1196
1201
(Out, What, HdrExtra) :-
1203 phrase(reply_header(What, HdrExtra, _Code), String),
1204 !,
1205 format(Out, '~s', [String]).
1206
1228
(Data, Dict) -->
1230 { _{header:HdrExtra, code:Code} :< Dict },
1231 reply_header(Data, HdrExtra, Code).
1232
(string(String), HdrExtra, Code) -->
1234 reply_header(string(text/plain, String), HdrExtra, Code).
1235reply_header(string(Type, String), HdrExtra, Code) -->
1236 vstatus(ok, Code, HdrExtra),
1237 date(now),
1238 header_fields(HdrExtra, CLen),
1239 content_length(codes(String, utf8), CLen),
1240 content_type(Type, utf8),
1241 "\r\n".
1242reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
1243 vstatus(ok, Code, HdrExtra),
1244 date(now),
1245 header_fields(HdrExtra, CLen),
1246 content_length(bytes(Bytes), CLen),
1247 content_type(Type),
1248 "\r\n".
1249reply_header(html(Tokens), HdrExtra, Code) -->
1250 vstatus(ok, Code, HdrExtra),
1251 date(now),
1252 header_fields(HdrExtra, CLen),
1253 content_length(html(Tokens), CLen),
1254 content_type(text/html),
1255 "\r\n".
1256reply_header(file(Type, File), HdrExtra, Code) -->
1257 vstatus(ok, Code, HdrExtra),
1258 date(now),
1259 modified(file(File)),
1260 header_fields(HdrExtra, CLen),
1261 content_length(file(File), CLen),
1262 content_type(Type),
1263 "\r\n".
1264reply_header(gzip_file(Type, File), HdrExtra, Code) -->
1265 vstatus(ok, Code, HdrExtra),
1266 date(now),
1267 modified(file(File)),
1268 header_fields(HdrExtra, CLen),
1269 content_length(file(File), CLen),
1270 content_type(Type),
1271 content_encoding(gzip),
1272 "\r\n".
1273reply_header(file(Type, File, Range), HdrExtra, Code) -->
1274 vstatus(partial_content, Code, HdrExtra),
1275 date(now),
1276 modified(file(File)),
1277 header_fields(HdrExtra, CLen),
1278 content_length(file(File, Range), CLen),
1279 content_type(Type),
1280 "\r\n".
1281reply_header(tmp_file(Type, File), HdrExtra, Code) -->
1282 vstatus(ok, Code, HdrExtra),
1283 date(now),
1284 header_fields(HdrExtra, CLen),
1285 content_length(file(File), CLen),
1286 content_type(Type),
1287 "\r\n".
1288reply_header(cgi_data(Size), HdrExtra, Code) -->
1289 vstatus(ok, Code, HdrExtra),
1290 date(now),
1291 header_fields(HdrExtra, CLen),
1292 content_length(Size, CLen),
1293 "\r\n".
1294reply_header(chunked_data, HdrExtra, Code) -->
1295 vstatus(ok, Code, HdrExtra),
1296 date(now),
1297 header_fields(HdrExtra, _),
1298 ( {memberchk(transfer_encoding(_), HdrExtra)}
1299 -> ""
1300 ; transfer_encoding(chunked)
1301 ),
1302 "\r\n".
1304reply_header(status(Status), HdrExtra, Code) -->
1305 vstatus(Status, Code),
1306 header_fields(HdrExtra, Clen),
1307 { Clen = 0 },
1308 "\r\n".
1310reply_header(Data, HdrExtra, Code) -->
1311 { status_reply_headers(Data,
1312 body(Type, Encoding, Content),
1313 ReplyHeaders),
1314 http_join_headers(ReplyHeaders, HdrExtra, Headers),
1315 functor(Data, CodeName, _)
1316 },
1317 vstatus(CodeName, Code, Headers),
1318 date(now),
1319 header_fields(Headers, CLen),
1320 content_length(codes(Content, Encoding), CLen),
1321 content_type(Type, Encoding),
1322 "\r\n".
1323
(created(Location, Body), Body,
1325 [ location(Location) ]).
1326status_reply_headers(moved(To, Body), Body,
1327 [ location(To) ]).
1328status_reply_headers(moved_temporary(To, Body), Body,
1329 [ location(To) ]).
1330status_reply_headers(gone(_URL, Body), Body, []).
1331status_reply_headers(see_other(To, Body), Body,
1332 [ location(To) ]).
1333status_reply_headers(authorise(Method, Body), Body,
1334 [ www_authenticate(Method) ]).
1335status_reply_headers(not_found(_URL, Body), Body, []).
1336status_reply_headers(forbidden(_URL, Body), Body, []).
1337status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
1338status_reply_headers(server_error(_Error, Body), Body, []).
1339status_reply_headers(service_unavailable(_Why, Body), Body, []).
1340status_reply_headers(not_acceptable(_Why, Body), Body, []).
1341status_reply_headers(bad_request(_Error, Body), Body, []).
1342
1343
1348
1349vstatus(_Status, Code, HdrExtra) -->
1350 {memberchk(status(Code), HdrExtra)},
1351 !,
1352 vstatus(_NewStatus, Code).
1353vstatus(Status, Code, _) -->
1354 vstatus(Status, Code).
1355
1356vstatus(Status, Code) -->
1357 "HTTP/1.1 ",
1358 status_number(Status, Code),
1359 " ",
1360 status_comment(Status),
1361 "\r\n".
1362
1369
1370status_number(Status, Code) -->
1371 { var(Status) },
1372 !,
1373 integer(Code),
1374 { status_number(Status, Code) },
1375 !.
1376status_number(Status, Code) -->
1377 { status_number(Status, Code) },
1378 integer(Code).
1379
1391
1399
1400status_number(Status, Code) :-
1401 nonvar(Status),
1402 !,
1403 status_number_fact(Status, Code).
1404status_number(Status, Code) :-
1405 nonvar(Code),
1406 !,
1407 ( between(100, 599, Code)
1408 -> ( status_number_fact(Status, Code)
1409 -> true
1410 ; ClassCode is Code // 100 * 100,
1411 status_number_fact(Status, ClassCode)
1412 )
1413 ; domain_error(http_code, Code)
1414 ).
1415
1416status_number_fact(continue, 100).
1417status_number_fact(switching_protocols, 101).
1418status_number_fact(ok, 200).
1419status_number_fact(created, 201).
1420status_number_fact(accepted, 202).
1421status_number_fact(non_authoritative_info, 203).
1422status_number_fact(no_content, 204).
1423status_number_fact(reset_content, 205).
1424status_number_fact(partial_content, 206).
1425status_number_fact(multiple_choices, 300).
1426status_number_fact(moved, 301).
1427status_number_fact(moved_temporary, 302).
1428status_number_fact(see_other, 303).
1429status_number_fact(not_modified, 304).
1430status_number_fact(use_proxy, 305).
1431status_number_fact(unused, 306).
1432status_number_fact(temporary_redirect, 307).
1433status_number_fact(bad_request, 400).
1434status_number_fact(authorise, 401).
1435status_number_fact(payment_required, 402).
1436status_number_fact(forbidden, 403).
1437status_number_fact(not_found, 404).
1438status_number_fact(method_not_allowed, 405).
1439status_number_fact(not_acceptable, 406).
1440status_number_fact(request_timeout, 408).
1441status_number_fact(conflict, 409).
1442status_number_fact(gone, 410).
1443status_number_fact(length_required, 411).
1444status_number_fact(payload_too_large, 413).
1445status_number_fact(uri_too_long, 414).
1446status_number_fact(unsupported_media_type, 415).
1447status_number_fact(expectation_failed, 417).
1448status_number_fact(upgrade_required, 426).
1449status_number_fact(server_error, 500).
1450status_number_fact(not_implemented, 501).
1451status_number_fact(bad_gateway, 502).
1452status_number_fact(service_unavailable, 503).
1453status_number_fact(gateway_timeout, 504).
1454status_number_fact(http_version_not_supported, 505).
1455
1456
1460
(continue) -->
1462 "Continue".
1463status_comment(switching_protocols) -->
1464 "Switching Protocols".
1465status_comment(ok) -->
1466 "OK".
1467status_comment(created) -->
1468 "Created".
1469status_comment(accepted) -->
1470 "Accepted".
1471status_comment(non_authoritative_info) -->
1472 "Non-Authoritative Information".
1473status_comment(no_content) -->
1474 "No Content".
1475status_comment(reset_content) -->
1476 "Reset Content".
1477status_comment(created) -->
1478 "Created".
1479status_comment(partial_content) -->
1480 "Partial content".
1481status_comment(multiple_choices) -->
1482 "Multiple Choices".
1483status_comment(moved) -->
1484 "Moved Permanently".
1485status_comment(moved_temporary) -->
1486 "Moved Temporary".
1487status_comment(see_other) -->
1488 "See Other".
1489status_comment(not_modified) -->
1490 "Not Modified".
1491status_comment(use_proxy) -->
1492 "Use Proxy".
1493status_comment(unused) -->
1494 "Unused".
1495status_comment(temporary_redirect) -->
1496 "Temporary Redirect".
1497status_comment(bad_request) -->
1498 "Bad Request".
1499status_comment(authorise) -->
1500 "Authorization Required".
1501status_comment(payment_required) -->
1502 "Payment Required".
1503status_comment(forbidden) -->
1504 "Forbidden".
1505status_comment(not_found) -->
1506 "Not Found".
1507status_comment(method_not_allowed) -->
1508 "Method Not Allowed".
1509status_comment(not_acceptable) -->
1510 "Not Acceptable".
1511status_comment(request_timeout) -->
1512 "Request Timeout".
1513status_comment(conflict) -->
1514 "Conflict".
1515status_comment(gone) -->
1516 "Gone".
1517status_comment(length_required) -->
1518 "Length Required".
1519status_comment(payload_too_large) -->
1520 "Payload Too Large".
1521status_comment(uri_too_long) -->
1522 "URI Too Long".
1523status_comment(unsupported_media_type) -->
1524 "Unsupported Media Type".
1525status_comment(expectation_failed) -->
1526 "Expectation Failed".
1527status_comment(upgrade_required) -->
1528 "Upgrade Required".
1529status_comment(server_error) -->
1530 "Internal Server Error".
1531status_comment(not_implemented) -->
1532 "Not Implemented".
1533status_comment(bad_gateway) -->
1534 "Bad Gateway".
1535status_comment(service_unavailable) -->
1536 "Service Unavailable".
1537status_comment(gateway_timeout) -->
1538 "Gateway Timeout".
1539status_comment(http_version_not_supported) -->
1540 "HTTP Version Not Supported".
1541
1542date(Time) -->
1543 "Date: ",
1544 ( { Time == now }
1545 -> now
1546 ; rfc_date(Time)
1547 ),
1548 "\r\n".
1549
1550modified(file(File)) -->
1551 !,
1552 { time_file(File, Time)
1553 },
1554 modified(Time).
1555modified(Time) -->
1556 "Last-modified: ",
1557 ( { Time == now }
1558 -> now
1559 ; rfc_date(Time)
1560 ),
1561 "\r\n".
1562
1563
1570
1571content_length(file(File, bytes(From, To)), Len) -->
1572 !,
1573 { size_file(File, Size),
1574 ( To == end
1575 -> Len is Size - From,
1576 RangeEnd is Size - 1
1577 ; Len is To+1 - From, 1578 RangeEnd = To
1579 )
1580 },
1581 content_range(bytes, From, RangeEnd, Size),
1582 content_length(Len, Len).
1583content_length(Reply, Len) -->
1584 { length_of(Reply, Len)
1585 },
1586 "Content-Length: ", integer(Len),
1587 "\r\n".
1588
1589
1590length_of(_, Len) :-
1591 nonvar(Len),
1592 !.
1593length_of(codes(String, Encoding), Len) :-
1594 !,
1595 setup_call_cleanup(
1596 open_null_stream(Out),
1597 ( set_stream(Out, encoding(Encoding)),
1598 format(Out, '~s', [String]),
1599 byte_count(Out, Len)
1600 ),
1601 close(Out)).
1602length_of(atom(Atom, Encoding), Len) :-
1603 !,
1604 setup_call_cleanup(
1605 open_null_stream(Out),
1606 ( set_stream(Out, encoding(Encoding)),
1607 format(Out, '~a', [Atom]),
1608 byte_count(Out, Len)
1609 ),
1610 close(Out)).
1611length_of(file(File), Len) :-
1612 !,
1613 size_file(File, Len).
1614length_of(memory_file(Handle), Len) :-
1615 !,
1616 size_memory_file(Handle, Len, octet).
1617length_of(html_tokens(Tokens), Len) :-
1618 !,
1619 html_print_length(Tokens, Len).
1620length_of(html(Tokens), Len) :- 1621 !,
1622 html_print_length(Tokens, Len).
1623length_of(bytes(Bytes), Len) :-
1624 !,
1625 ( string(Bytes)
1626 -> string_length(Bytes, Len)
1627 ; length(Bytes, Len) 1628 ).
1629length_of(Len, Len).
1630
1631
1636
1637content_range(Unit, From, RangeEnd, Size) -->
1638 "Content-Range: ", atom(Unit), " ",
1639 integer(From), "-", integer(RangeEnd), "/", integer(Size),
1640 "\r\n".
1641
1642content_encoding(Encoding) -->
1643 "Content-Encoding: ", atom(Encoding), "\r\n".
1644
1645transfer_encoding(Encoding) -->
1646 "Transfer-Encoding: ", atom(Encoding), "\r\n".
1647
1648content_type(Type) -->
1649 content_type(Type, _).
1650
1651content_type(Type, Charset) -->
1652 ctype(Type),
1653 charset(Charset),
1654 "\r\n".
1655
1656ctype(Main/Sub) -->
1657 !,
1658 "Content-Type: ",
1659 atom(Main),
1660 "/",
1661 atom(Sub).
1662ctype(Type) -->
1663 !,
1664 "Content-Type: ",
1665 atom(Type).
1666
1667charset(Var) -->
1668 { var(Var) },
1669 !.
1670charset(utf8) -->
1671 !,
1672 "; charset=UTF-8".
1673charset(CharSet) -->
1674 "; charset=",
1675 atom(CharSet).
1676
1682
(Name, Value) -->
1684 { var(Name) }, 1685 !,
1686 field_name(Name),
1687 ":",
1688 whites,
1689 read_field_value(ValueChars),
1690 blanks_to_nl,
1691 !,
1692 { field_to_prolog(Name, ValueChars, Value)
1693 -> true
1694 ; atom_codes(Value, ValueChars),
1695 domain_error(Name, Value)
1696 }.
1697header_field(Name, Value) -->
1698 field_name(Name),
1699 ": ",
1700 field_value(Name, Value),
1701 "\r\n".
1702
1706
1707read_field_value([H|T]) -->
1708 [H],
1709 { \+ code_type(H, space) },
1710 !,
1711 read_field_value(T).
1712read_field_value([]) -->
1713 "".
1714read_field_value([H|T]) -->
1715 [H],
1716 read_field_value(T).
1717
1718
1756
(Field, Value, Prolog) :-
1758 known_field(Field, _, Type),
1759 ( already_parsed(Type, Value)
1760 -> Prolog = Value
1761 ; to_codes(Value, Codes),
1762 parse_header_value(Field, Codes, Prolog)
1763 ).
1764
1765already_parsed(integer, V) :- !, integer(V).
1766already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
1767already_parsed(Term, V) :- subsumes_term(Term, V).
1768
1769
1774
1775known_field(content_length, true, integer).
1776known_field(status, true, integer).
1777known_field(cookie, true, list(_=_)).
1778known_field(set_cookie, true, list(set_cookie(_Name,_Value,_Options))).
1779known_field(host, true, _Host:_Port).
1780known_field(range, maybe, bytes(_,_)).
1781known_field(accept, maybe, list(media(_Type, _Parms, _Q, _Exts))).
1782known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
1783known_field(content_type, false, media(_Type/_Sub, _Attributes)).
1784
1785to_codes(In, Codes) :-
1786 ( is_list(In)
1787 -> Codes = In
1788 ; atom_codes(In, Codes)
1789 ).
1790
1796
1797field_to_prolog(Field, Codes, Prolog) :-
1798 known_field(Field, true, _Type),
1799 !,
1800 ( parse_header_value(Field, Codes, Prolog0)
1801 -> Prolog = Prolog0
1802 ).
1803field_to_prolog(Field, Codes, Prolog) :-
1804 known_field(Field, maybe, _Type),
1805 parse_header_value(Field, Codes, Prolog0),
1806 !,
1807 Prolog = Prolog0.
1808field_to_prolog(_, Codes, Atom) :-
1809 atom_codes(Atom, Codes).
1810
1815
(content_length, ValueChars, ContentLength) :-
1817 number_codes(ContentLength, ValueChars).
1818parse_header_value(status, ValueChars, Code) :-
1819 ( phrase(" ", L, _),
1820 append(Pre, L, ValueChars)
1821 -> number_codes(Code, Pre)
1822 ; number_codes(Code, ValueChars)
1823 ).
1824parse_header_value(cookie, ValueChars, Cookies) :-
1825 debug(cookie, 'Cookie: ~s', [ValueChars]),
1826 phrase(cookies(Cookies), ValueChars).
1827parse_header_value(set_cookie, ValueChars, SetCookie) :-
1828 debug(cookie, 'SetCookie: ~s', [ValueChars]),
1829 phrase(set_cookie(SetCookie), ValueChars).
1830parse_header_value(host, ValueChars, Host) :-
1831 ( append(HostChars, [0':|PortChars], ValueChars),
1832 catch(number_codes(Port, PortChars), _, fail)
1833 -> atom_codes(HostName, HostChars),
1834 Host = HostName:Port
1835 ; atom_codes(Host, ValueChars)
1836 ).
1837parse_header_value(range, ValueChars, Range) :-
1838 phrase(range(Range), ValueChars).
1839parse_header_value(accept, ValueChars, Media) :-
1840 parse_accept(ValueChars, Media).
1841parse_header_value(content_disposition, ValueChars, Disposition) :-
1842 phrase(content_disposition(Disposition), ValueChars).
1843parse_header_value(content_type, ValueChars, Type) :-
1844 phrase(parse_content_type(Type), ValueChars).
1845
1847
1848field_value(_, set_cookie(Name, Value, Options)) -->
1849 !,
1850 atom(Name), "=", atom(Value),
1851 value_options(Options, cookie).
1852field_value(_, disposition(Disposition, Options)) -->
1853 !,
1854 atom(Disposition), value_options(Options, disposition).
1855field_value(www_authenticate, Auth) -->
1856 auth_field_value(Auth).
1857field_value(_, Atomic) -->
1858 atom(Atomic).
1859
1863
1864auth_field_value(negotiate(Data)) -->
1865 "Negotiate ",
1866 { base64(Data, DataBase64),
1867 atom_codes(DataBase64, Codes)
1868 },
1869 string(Codes).
1870auth_field_value(negotiate) -->
1871 "Negotiate".
1872auth_field_value(basic) -->
1873 !,
1874 "Basic".
1875auth_field_value(basic(Realm)) -->
1876 "Basic Realm=\"", atom(Realm), "\"".
1877auth_field_value(digest) -->
1878 !,
1879 "Digest".
1880auth_field_value(digest(Details)) -->
1881 "Digest ", atom(Details).
1882
1889
1890value_options([], _) --> [].
1891value_options([H|T], Field) -->
1892 "; ", value_option(H, Field),
1893 value_options(T, Field).
1894
1895value_option(secure=true, cookie) -->
1896 !,
1897 "secure".
1898value_option(Name=Value, Type) -->
1899 { string_option(Name, Type) },
1900 !,
1901 atom(Name), "=",
1902 qstring(Value).
1903value_option(Name=Value, Type) -->
1904 { token_option(Name, Type) },
1905 !,
1906 atom(Name), "=", atom(Value).
1907value_option(Name=Value, _Type) -->
1908 atom(Name), "=",
1909 option_value(Value).
1910
1911string_option(filename, disposition).
1912
1913token_option(path, cookie).
1914
1915option_value(Value) -->
1916 { number(Value) },
1917 !,
1918 number(Value).
1919option_value(Value) -->
1920 { ( atom(Value)
1921 -> true
1922 ; string(Value)
1923 ),
1924 forall(string_code(_, Value, C),
1925 token_char(C))
1926 },
1927 !,
1928 atom(Value).
1929option_value(Atomic) -->
1930 qstring(Atomic).
1931
1932qstring(Atomic) -->
1933 { string_codes(Atomic, Codes) },
1934 "\"",
1935 qstring_codes(Codes),
1936 "\"".
1937
1938qstring_codes([]) --> [].
1939qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
1940
1941qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
1942qstring_code(C) --> [C].
1943
1944qstring_esc(0'").
1945qstring_esc(C) :- ctl(C).
1946
1947
1948 1951
1952:- dynamic accept_cache/2. 1953:- volatile accept_cache/2. 1954
1955parse_accept(Codes, Media) :-
1956 atom_codes(Atom, Codes),
1957 ( accept_cache(Atom, Media0)
1958 -> Media = Media0
1959 ; phrase(accept(Media0), Codes),
1960 keysort(Media0, Media1),
1961 pairs_values(Media1, Media2),
1962 assertz(accept_cache(Atom, Media2)),
1963 Media = Media2
1964 ).
1965
1969
1970accept([H|T]) -->
1971 blanks,
1972 media_range(H),
1973 blanks,
1974 ( ","
1975 -> accept(T)
1976 ; {T=[]}
1977 ).
1978
1979media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
1980 media_type(Type),
1981 blanks,
1982 ( ";"
1983 -> blanks,
1984 parameters_and_quality(TypeParams, Quality, AcceptExts)
1985 ; { TypeParams = [],
1986 Quality = 1.0,
1987 AcceptExts = []
1988 }
1989 ),
1990 { SortQuality is float(-Quality),
1991 rank_specialised(Type, TypeParams, Spec)
1992 }.
1993
1994
1998
1999content_disposition(disposition(Disposition, Options)) -->
2000 token(Disposition), blanks,
2001 value_parameters(Options).
2002
2007
2008parse_content_type(media(Type, Parameters)) -->
2009 media_type(Type), blanks,
2010 value_parameters(Parameters).
2011
2012
2020
2021rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
2022 var_or_given(Type, VT),
2023 var_or_given(SubType, VS),
2024 length(TypeParams, VP),
2025 SortVP is -VP.
2026
2027var_or_given(V, Val) :-
2028 ( var(V)
2029 -> Val = 0
2030 ; Val = -1
2031 ).
2032
2033media_type(Type/SubType) -->
2034 type(Type), "/", type(SubType).
2035
2036type(_) -->
2037 "*",
2038 !.
2039type(Type) -->
2040 token(Type).
2041
2042parameters_and_quality(Params, Quality, AcceptExts) -->
2043 token(Name),
2044 blanks, "=", blanks,
2045 ( { Name == q }
2046 -> float(Quality), blanks,
2047 value_parameters(AcceptExts),
2048 { Params = [] }
2049 ; { Params = [Name=Value|T] },
2050 parameter_value(Value),
2051 blanks,
2052 ( ";"
2053 -> blanks,
2054 parameters_and_quality(T, Quality, AcceptExts)
2055 ; { T = [],
2056 Quality = 1.0,
2057 AcceptExts = []
2058 }
2059 )
2060 ).
2061
2066
2067value_parameters([H|T]) -->
2068 ";",
2069 !,
2070 blanks, token(Name), blanks,
2071 ( "="
2072 -> blanks,
2073 ( token(Value)
2074 -> []
2075 ; quoted_string(Value)
2076 ),
2077 { H = (Name=Value) }
2078 ; { H = Name }
2079 ),
2080 blanks,
2081 value_parameters(T).
2082value_parameters([]) -->
2083 [].
2084
2085parameter_value(Value) --> token(Value), !.
2086parameter_value(Value) --> quoted_string(Value).
2087
2088
2092
2093token(Name) -->
2094 token_char(C1),
2095 token_chars(Cs),
2096 { atom_codes(Name, [C1|Cs]) }.
2097
2098token_chars([H|T]) -->
2099 token_char(H),
2100 !,
2101 token_chars(T).
2102token_chars([]) --> [].
2103
2104token_char(C) :-
2105 \+ ctl(C),
2106 \+ separator_code(C).
2107
2108ctl(C) :- between(0,31,C), !.
2109ctl(127).
2110
2111separator_code(0'().
2112separator_code(0')).
2113separator_code(0'<).
2114separator_code(0'>).
2115separator_code(0'@).
2116separator_code(0',).
2117separator_code(0';).
2118separator_code(0':).
2119separator_code(0'\\).
2120separator_code(0'").
2121separator_code(0'/).
2122separator_code(0'[).
2123separator_code(0']).
2124separator_code(0'?).
2125separator_code(0'=).
2126separator_code(0'{).
2127separator_code(0'}).
2128separator_code(0'\s).
2129separator_code(0'\t).
2130
2131term_expansion(token_char(x) --> [x], Clauses) :-
2132 findall((token_char(C)-->[C]),
2133 ( between(0, 255, C),
2134 token_char(C)
2135 ),
2136 Clauses).
2137
2138token_char(x) --> [x].
2139
2143
2144quoted_string(Text) -->
2145 "\"",
2146 quoted_text(Codes),
2147 { atom_codes(Text, Codes) }.
2148
2149quoted_text([]) -->
2150 "\"",
2151 !.
2152quoted_text([H|T]) -->
2153 "\\", !, [H],
2154 quoted_text(T).
2155quoted_text([H|T]) -->
2156 [H],
2157 !,
2158 quoted_text(T).
2159
2160
2168
([], _) --> [].
2170header_fields([content_length(CLen)|T], CLen) -->
2171 !,
2172 ( { var(CLen) }
2173 -> ""
2174 ; header_field(content_length, CLen)
2175 ),
2176 header_fields(T, CLen). 2177header_fields([status(_)|T], CLen) --> 2178 !,
2179 header_fields(T, CLen).
2180header_fields([H|T], CLen) -->
2181 { H =.. [Name, Value] },
2182 header_field(Name, Value),
2183 header_fields(T, CLen).
2184
2185
2199
2200:- public
2201 field_name//1. 2202
2203field_name(Name) -->
2204 { var(Name) },
2205 !,
2206 rd_field_chars(Chars),
2207 { atom_codes(Name, Chars) }.
2208field_name(mime_version) -->
2209 !,
2210 "MIME-Version".
2211field_name(www_authenticate) -->
2212 !,
2213 "WWW-Authenticate".
2214field_name(Name) -->
2215 { atom_codes(Name, Chars) },
2216 wr_field_chars(Chars).
2217
2218rd_field_chars_no_fold([C|T]) -->
2219 [C],
2220 { rd_field_char(C, _) },
2221 !,
2222 rd_field_chars_no_fold(T).
2223rd_field_chars_no_fold([]) -->
2224 [].
2225
2226rd_field_chars([C0|T]) -->
2227 [C],
2228 { rd_field_char(C, C0) },
2229 !,
2230 rd_field_chars(T).
2231rd_field_chars([]) -->
2232 [].
2233
2237
2238separators("()<>@,;:\\\"/[]?={} \t").
2239
2240term_expansion(rd_field_char('expand me',_), Clauses) :-
2241
2242 Clauses = [ rd_field_char(0'-, 0'_)
2243 | Cls
2244 ],
2245 separators(SepString),
2246 string_codes(SepString, Seps),
2247 findall(rd_field_char(In, Out),
2248 ( between(32, 127, In),
2249 \+ memberchk(In, Seps),
2250 In \== 0'-, 2251 code_type(Out, to_lower(In))),
2252 Cls).
2253
2254rd_field_char('expand me', _). 2255
2256wr_field_chars([C|T]) -->
2257 !,
2258 { code_type(C, to_lower(U)) },
2259 [U],
2260 wr_field_chars2(T).
2261wr_field_chars([]) -->
2262 [].
2263
2264wr_field_chars2([]) --> [].
2265wr_field_chars2([C|T]) --> 2266 ( { C == 0'_ }
2267 -> "-",
2268 wr_field_chars(T)
2269 ; [C],
2270 wr_field_chars2(T)
2271 ).
2272
2276
2277now -->
2278 { get_time(Time)
2279 },
2280 rfc_date(Time).
2281
2286
2287rfc_date(Time, String, Tail) :-
2288 stamp_date_time(Time, Date, 'UTC'),
2289 format_time(codes(String, Tail),
2290 '%a, %d %b %Y %T GMT',
2291 Date, posix).
2292
2296
2297http_timestamp(Time, Atom) :-
2298 stamp_date_time(Time, Date, 'UTC'),
2299 format_time(atom(Atom),
2300 '%a, %d %b %Y %T GMT',
2301 Date, posix).
2302
2303
2304 2307
2308request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
2309 method(Method),
2310 blanks,
2311 nonblanks(Query),
2312 { atom_codes(ReqURI, Query),
2313 request_uri_parts(ReqURI, Header, Rest)
2314 },
2315 request_header(Fd, Rest),
2316 !.
2317request(Fd, [unknown(What)|Header]) -->
2318 string(What),
2319 eos,
2320 !,
2321 { http_read_header(Fd, Header)
2322 -> true
2323 ; Header = []
2324 }.
2325
2326method(get) --> "GET", !.
2327method(put) --> "PUT", !.
2328method(head) --> "HEAD", !.
2329method(post) --> "POST", !.
2330method(delete) --> "DELETE", !.
2331method(patch) --> "PATCH", !.
2332method(options) --> "OPTIONS", !.
2333method(trace) --> "TRACE", !.
2334
2346
2347request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
2348 uri_components(ReqURI, Components),
2349 uri_data(path, Components, PathText),
2350 uri_encoded(path, Path, PathText),
2351 phrase(uri_parts(Components), Parts, Rest).
2352
2353uri_parts(Components) -->
2354 uri_search(Components),
2355 uri_fragment(Components).
2356
2357uri_search(Components) -->
2358 { uri_data(search, Components, Search),
2359 nonvar(Search),
2360 catch(uri_query_components(Search, Query),
2361 error(syntax_error(_),_),
2362 fail)
2363 },
2364 !,
2365 [ search(Query) ].
2366uri_search(_) --> [].
2367
2368uri_fragment(Components) -->
2369 { uri_data(fragment, Components, String),
2370 nonvar(String),
2371 !,
2372 uri_encoded(fragment, Fragment, String)
2373 },
2374 [ fragment(Fragment) ].
2375uri_fragment(_) --> [].
2376
2381
(_, []) --> 2383 blanks,
2384 eos,
2385 !.
2386request_header(Fd, [http_version(Version)|Header]) -->
2387 http_version(Version),
2388 blanks,
2389 eos,
2390 !,
2391 { Version = 1-_
2392 -> http_read_header(Fd, Header)
2393 ; Header = []
2394 }.
2395
2396http_version(Version) -->
2397 blanks,
2398 "HTTP/",
2399 http_version_number(Version).
2400
2401http_version_number(Major-Minor) -->
2402 integer(Major),
2403 ".",
2404 integer(Minor).
2405
2406
2407 2410
2414
2415cookies([Name=Value|T]) -->
2416 blanks,
2417 cookie(Name, Value),
2418 !,
2419 blanks,
2420 ( ";"
2421 -> cookies(T)
2422 ; { T = [] }
2423 ).
2424cookies(List) -->
2425 string(Skipped),
2426 ";",
2427 !,
2428 { print_message(warning, http(skipped_cookie(Skipped))) },
2429 cookies(List).
2430cookies([]) -->
2431 blanks.
2432
2433cookie(Name, Value) -->
2434 cookie_name(Name),
2435 blanks, "=", blanks,
2436 cookie_value(Value).
2437
2438cookie_name(Name) -->
2439 { var(Name) },
2440 !,
2441 rd_field_chars_no_fold(Chars),
2442 { atom_codes(Name, Chars) }.
2443
2444cookie_value(Value) -->
2445 quoted_string(Value),
2446 !.
2447cookie_value(Value) -->
2448 chars_to_semicolon_or_blank(Chars),
2449 { atom_codes(Value, Chars)
2450 }.
2451
2452chars_to_semicolon_or_blank([]), ";" -->
2453 ";",
2454 !.
2455chars_to_semicolon_or_blank([]) -->
2456 " ",
2457 blanks,
2458 eos,
2459 !.
2460chars_to_semicolon_or_blank([H|T]) -->
2461 [H],
2462 !,
2463 chars_to_semicolon_or_blank(T).
2464chars_to_semicolon_or_blank([]) -->
2465 [].
2466
2467set_cookie(set_cookie(Name, Value, Options)) -->
2468 ws,
2469 cookie(Name, Value),
2470 cookie_options(Options).
2471
2472cookie_options([H|T]) -->
2473 ws,
2474 ";",
2475 ws,
2476 cookie_option(H),
2477 !,
2478 cookie_options(T).
2479cookie_options([]) -->
2480 ws.
2481
2482ws --> " ", !, ws.
2483ws --> [].
2484
2485
2494
2495cookie_option(Name=Value) -->
2496 rd_field_chars(NameChars), ws,
2497 { atom_codes(Name, NameChars) },
2498 ( "="
2499 -> ws,
2500 chars_to_semicolon(ValueChars),
2501 { atom_codes(Value, ValueChars)
2502 }
2503 ; { Value = true }
2504 ).
2505
2506chars_to_semicolon([H|T]) -->
2507 [H],
2508 { H \== 32, H \== 0'; },
2509 !,
2510 chars_to_semicolon(T).
2511chars_to_semicolon([]), ";" -->
2512 ws, ";",
2513 !.
2514chars_to_semicolon([H|T]) -->
2515 [H],
2516 chars_to_semicolon(T).
2517chars_to_semicolon([]) -->
2518 [].
2519
2527
2528range(bytes(From, To)) -->
2529 "bytes", whites, "=", whites, integer(From), "-",
2530 ( integer(To)
2531 -> ""
2532 ; { To = end }
2533 ).
2534
2535
2536 2539
2554
2555reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
2556 http_version(HttpVersion),
2557 blanks,
2558 ( status_number(Status, Code)
2559 -> []
2560 ; integer(Status)
2561 ),
2562 blanks,
2563 string(CommentCodes),
2564 blanks_to_nl,
2565 !,
2566 blanks,
2567 { atom_codes(Comment, CommentCodes),
2568 http_read_header(Fd, Header)
2569 }.
2570
2571
2572 2575
2581
(Fd, Header) :-
2583 read_header_data(Fd, Text),
2584 http_parse_header(Text, Header).
2585
(Fd, Header) :-
2587 read_line_to_codes(Fd, Header, Tail),
2588 read_header_data(Header, Fd, Tail),
2589 debug(http(header), 'Header = ~n~s~n', [Header]).
2590
([0'\r,0'\n], _, _) :- !.
2592read_header_data([0'\n], _, _) :- !.
2593read_header_data([], _, _) :- !.
2594read_header_data(_, Fd, Tail) :-
2595 read_line_to_codes(Fd, Tail, NewTail),
2596 read_header_data(Tail, Fd, NewTail).
2597
2604
(Text, Header) :-
2606 phrase(header(Header), Text),
2607 debug(http(header), 'Field: ~p', [Header]).
2608
(List) -->
2610 header_field(Name, Value),
2611 !,
2612 { mkfield(Name, Value, List, Tail)
2613 },
2614 blanks,
2615 header(Tail).
2616header([]) -->
2617 blanks,
2618 eos,
2619 !.
2620header(_) -->
2621 string(S), blanks_to_nl,
2622 !,
2623 { string_codes(Line, S),
2624 syntax_error(http_parameter(Line))
2625 }.
2626
2638
2639:- multifile
2640 http:http_address//0. 2641
2642address -->
2643 http:http_address,
2644 !.
2645address -->
2646 { gethostname(Host) },
2647 html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
2648 ' httpd at ', Host
2649 ])).
2650
2651mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
2652mkfield(Name, Value, [Att|Tail], Tail) :-
2653 Att =.. [Name, Value].
2654
2660
2690
2691
2692 2695
2696:- multifile
2697 prolog:message//1,
2698 prolog:error_message//1. 2699
2700prolog:error_message(http_write_short(Data, Sent)) -->
2701 data(Data),
2702 [ ': remote hangup after ~D bytes'-[Sent] ].
2703prolog:error_message(syntax_error(http_request(Request))) -->
2704 [ 'Illegal HTTP request: ~s'-[Request] ].
2705prolog:error_message(syntax_error(http_parameter(Line))) -->
2706 [ 'Illegal HTTP parameter: ~s'-[Line] ].
2707
2708prolog:message(http(skipped_cookie(S))) -->
2709 [ 'Skipped illegal cookie: ~s'-[S] ].
2710
2711data(bytes(MimeType, _Bytes)) -->
2712 !,
2713 [ 'bytes(~p, ...)'-[MimeType] ].
2714data(Data) -->
2715 [ '~p'-[Data] ]