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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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 send_reply_header(Out, 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([ansi(_Style,Fmt,Args)|T]) -->
711 !,
712 { format(string(S), Fmt, Args)
713 },
714 html([S]),
715 html_message_lines(T).
716html_message_lines([url(Pos)|T]) -->
717 !,
718 msg_url(Pos),
719 html_message_lines(T).
720html_message_lines([url(URL, Label)|T]) -->
721 !,
722 html(a(href(URL), Label)),
723 html_message_lines(T).
724html_message_lines([Fmt-Args|T]) -->
725 !,
726 { format(string(S), Fmt, Args)
727 },
728 html([S]),
729 html_message_lines(T).
730html_message_lines([Fmt|T]) -->
731 !,
732 { format(string(S), Fmt, [])
733 },
734 html([S]),
735 html_message_lines(T).
736
737msg_url(File:Line:Pos) -->
738 !,
739 html([File, :, Line, :, Pos]).
740msg_url(File:Line) -->
741 !,
742 html([File, :, Line]).
743msg_url(File) -->
744 html([File]).
745
750
([], H, H).
752http_join_headers([H|T], Hdr0, Hdr) :-
753 functor(H, N, A),
754 functor(H2, N, A),
755 member(H2, Hdr0),
756 !,
757 http_join_headers(T, Hdr0, Hdr).
758http_join_headers([H|T], Hdr0, [H|Hdr]) :-
759 http_join_headers(T, Hdr0, Hdr).
760
761
770
771http_update_encoding(Header0, utf8, [content_type(Type)|Header]) :-
772 select(content_type(Type0), Header0, Header),
773 sub_atom(Type0, 0, _, _, 'text/'),
774 !,
775 ( sub_atom(Type0, S, _, _, ';')
776 -> sub_atom(Type0, 0, S, _, B)
777 ; B = Type0
778 ),
779 atom_concat(B, '; charset=UTF-8', Type).
780http_update_encoding(Header, Encoding, Header) :-
781 memberchk(content_type(Type), Header),
782 ( ( sub_atom(Type, _, _, _, 'UTF-8')
783 ; sub_atom(Type, _, _, _, 'utf-8')
784 )
785 -> Encoding = utf8
786 ; http:mime_type_encoding(Type, Encoding)
787 -> true
788 ; mime_type_encoding(Type, Encoding)
789 ).
790http_update_encoding(Header, octet, Header).
791
796
797mime_type_encoding('application/json', utf8).
798mime_type_encoding('application/jsonrequest', utf8).
799mime_type_encoding('application/x-prolog', utf8).
800mime_type_encoding('application/n-quads', utf8).
801mime_type_encoding('application/n-triples', utf8).
802mime_type_encoding('application/sparql-query', utf8).
803mime_type_encoding('application/trig', utf8).
804
812
813
818
819http_update_connection(CgiHeader, Request, Connect,
820 [connection(Connect)|Rest]) :-
821 select(connection(CgiConn), CgiHeader, Rest),
822 !,
823 connection(Request, ReqConnection),
824 join_connection(ReqConnection, CgiConn, Connect).
825http_update_connection(CgiHeader, Request, Connect,
826 [connection(Connect)|CgiHeader]) :-
827 connection(Request, Connect).
828
829join_connection(Keep1, Keep2, Connection) :-
830 ( downcase_atom(Keep1, 'keep-alive'),
831 downcase_atom(Keep2, 'keep-alive')
832 -> Connection = 'Keep-Alive'
833 ; Connection = close
834 ).
835
836
840
841connection(Header, Close) :-
842 ( memberchk(connection(Connection), Header)
843 -> Close = Connection
844 ; memberchk(http_version(1-X), Header),
845 X >= 1
846 -> Close = 'Keep-Alive'
847 ; Close = close
848 ).
849
850
866
867http_update_transfer(Request, CgiHeader, Transfer, Header) :-
868 setting(http:chunked_transfer, When),
869 http_update_transfer(When, Request, CgiHeader, Transfer, Header).
870
871http_update_transfer(never, _, CgiHeader, none, Header) :-
872 !,
873 delete(CgiHeader, transfer_encoding(_), Header).
874http_update_transfer(_, _, CgiHeader, none, Header) :-
875 memberchk(location(_), CgiHeader),
876 !,
877 delete(CgiHeader, transfer_encoding(_), Header).
878http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
879 select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
880 !,
881 transfer(Request, ReqConnection),
882 join_transfer(ReqConnection, CgiTransfer, Transfer),
883 ( Transfer == none
884 -> Header = Rest
885 ; Header = [transfer_encoding(Transfer)|Rest]
886 ).
887http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
888 transfer(Request, Transfer),
889 Transfer \== none,
890 !,
891 Header = [transfer_encoding(Transfer)|CgiHeader].
892http_update_transfer(_, _, CgiHeader, none, CgiHeader).
893
894join_transfer(chunked, chunked, chunked) :- !.
895join_transfer(_, _, none).
896
897
901
902transfer(Header, Transfer) :-
903 ( memberchk(transfer_encoding(Transfer0), Header)
904 -> Transfer = Transfer0
905 ; memberchk(http_version(1-X), Header),
906 X >= 1
907 -> Transfer = chunked
908 ; Transfer = none
909 ).
910
911
917
918content_length_in_encoding(Enc, Stream, Bytes) :-
919 stream_property(Stream, position(Here)),
920 setup_call_cleanup(
921 open_null_stream(Out),
922 ( set_stream(Out, encoding(Enc)),
923 catch(copy_stream_data(Stream, Out), _, fail),
924 flush_output(Out),
925 byte_count(Out, Bytes)
926 ),
927 ( close(Out, [force(true)]),
928 set_stream_position(Stream, Here)
929 )).
930
931
932 935
1026
1027http_post_data(Data, Out, HdrExtra) :-
1028 http:post_data_hook(Data, Out, HdrExtra),
1029 !.
1030http_post_data(html(HTML), Out, HdrExtra) :-
1031 !,
1032 phrase(post_header(html(HTML), HdrExtra), Header),
1033 send_request_header(Out, Header),
1034 print_html(Out, HTML).
1035http_post_data(xml(XML), Out, HdrExtra) :-
1036 !,
1037 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
1038http_post_data(xml(Type, XML), Out, HdrExtra) :-
1039 !,
1040 http_post_data(xml(Type, XML, []), Out, HdrExtra).
1041http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
1042 !,
1043 setup_call_cleanup(
1044 new_memory_file(MemFile),
1045 ( setup_call_cleanup(
1046 open_memory_file(MemFile, write, MemOut),
1047 xml_write(MemOut, XML, Options),
1048 close(MemOut)),
1049 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
1050 ),
1051 free_memory_file(MemFile)).
1052http_post_data(file(File), Out, HdrExtra) :-
1053 !,
1054 ( file_mime_type(File, Type)
1055 -> true
1056 ; Type = text/plain
1057 ),
1058 http_post_data(file(Type, File), Out, HdrExtra).
1059http_post_data(file(Type, File), Out, HdrExtra) :-
1060 !,
1061 phrase(post_header(file(Type, File), HdrExtra), Header),
1062 send_request_header(Out, Header),
1063 setup_call_cleanup(
1064 open(File, read, In, [type(binary)]),
1065 copy_stream_data(In, Out),
1066 close(In)).
1067http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
1068 !,
1069 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1070 send_request_header(Out, Header),
1071 setup_call_cleanup(
1072 open_memory_file(Handle, read, In, [encoding(octet)]),
1073 copy_stream_data(In, Out),
1074 close(In)).
1075http_post_data(codes(Codes), Out, HdrExtra) :-
1076 !,
1077 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1078http_post_data(codes(Type, Codes), Out, HdrExtra) :-
1079 !,
1080 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1081 send_request_header(Out, Header),
1082 setup_call_cleanup(
1083 set_stream(Out, encoding(utf8)),
1084 format(Out, '~s', [Codes]),
1085 set_stream(Out, encoding(octet))).
1086http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
1087 !,
1088 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1089 send_request_header(Out, Header),
1090 format(Out, '~s', [Bytes]).
1091http_post_data(atom(Atom), Out, HdrExtra) :-
1092 !,
1093 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1094http_post_data(atom(Type, Atom), Out, HdrExtra) :-
1095 !,
1096 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1097 send_request_header(Out, Header),
1098 setup_call_cleanup(
1099 set_stream(Out, encoding(utf8)),
1100 write(Out, Atom),
1101 set_stream(Out, encoding(octet))).
1102http_post_data(string(String), Out, HdrExtra) :-
1103 !,
1104 http_post_data(atom(text/plain, String), Out, HdrExtra).
1105http_post_data(string(Type, String), Out, HdrExtra) :-
1106 !,
1107 phrase(post_header(string(Type, String), HdrExtra), Header),
1108 send_request_header(Out, Header),
1109 setup_call_cleanup(
1110 set_stream(Out, encoding(utf8)),
1111 write(Out, String),
1112 set_stream(Out, encoding(octet))).
1113http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
1114 !,
1115 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1116 http_post_data(cgi_stream(In), Out, HdrExtra).
1117http_post_data(cgi_stream(In), Out, HdrExtra) :-
1118 !,
1119 http_read_header(In, Header0),
1120 http_update_encoding(Header0, Encoding, Header),
1121 content_length_in_encoding(Encoding, In, Size),
1122 http_join_headers(HdrExtra, Header, Hdr2),
1123 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1124 send_request_header(Out, HeaderText),
1125 setup_call_cleanup(
1126 set_stream(Out, encoding(Encoding)),
1127 copy_stream_data(In, Out),
1128 set_stream(Out, encoding(octet))).
1129http_post_data(form(Fields), Out, HdrExtra) :-
1130 !,
1131 parse_url_search(Codes, Fields),
1132 length(Codes, Size),
1133 http_join_headers(HdrExtra,
1134 [ content_type('application/x-www-form-urlencoded')
1135 ], Header),
1136 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1137 send_request_header(Out, HeaderChars),
1138 format(Out, '~s', [Codes]).
1139http_post_data(form_data(Data), Out, HdrExtra) :-
1140 !,
1141 setup_call_cleanup(
1142 new_memory_file(MemFile),
1143 ( setup_call_cleanup(
1144 open_memory_file(MemFile, write, MimeOut),
1145 mime_pack(Data, MimeOut, Boundary),
1146 close(MimeOut)),
1147 size_memory_file(MemFile, Size, octet),
1148 format(string(ContentType),
1149 'multipart/form-data; boundary=~w', [Boundary]),
1150 http_join_headers(HdrExtra,
1151 [ mime_version('1.0'),
1152 content_type(ContentType)
1153 ], Header),
1154 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1155 send_request_header(Out, HeaderChars),
1156 setup_call_cleanup(
1157 open_memory_file(MemFile, read, In, [encoding(octet)]),
1158 copy_stream_data(In, Out),
1159 close(In))
1160 ),
1161 free_memory_file(MemFile)).
1162http_post_data(List, Out, HdrExtra) :- 1163 is_list(List),
1164 !,
1165 setup_call_cleanup(
1166 new_memory_file(MemFile),
1167 ( setup_call_cleanup(
1168 open_memory_file(MemFile, write, MimeOut),
1169 mime_pack(List, MimeOut, Boundary),
1170 close(MimeOut)),
1171 size_memory_file(MemFile, Size, octet),
1172 format(string(ContentType),
1173 'multipart/mixed; boundary=~w', [Boundary]),
1174 http_join_headers(HdrExtra,
1175 [ mime_version('1.0'),
1176 content_type(ContentType)
1177 ], Header),
1178 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1179 send_request_header(Out, HeaderChars),
1180 setup_call_cleanup(
1181 open_memory_file(MemFile, read, In, [encoding(octet)]),
1182 copy_stream_data(In, Out),
1183 close(In))
1184 ),
1185 free_memory_file(MemFile)).
1186
1191
(html(Tokens), HdrExtra) -->
1193 header_fields(HdrExtra, Len),
1194 content_length(html(Tokens), Len),
1195 content_type(text/html),
1196 "\r\n".
1197post_header(file(Type, File), HdrExtra) -->
1198 header_fields(HdrExtra, Len),
1199 content_length(file(File), Len),
1200 content_type(Type),
1201 "\r\n".
1202post_header(memory_file(Type, File), HdrExtra) -->
1203 header_fields(HdrExtra, Len),
1204 content_length(memory_file(File), Len),
1205 content_type(Type),
1206 "\r\n".
1207post_header(cgi_data(Size), HdrExtra) -->
1208 header_fields(HdrExtra, Len),
1209 content_length(Size, Len),
1210 "\r\n".
1211post_header(codes(Type, Codes), HdrExtra) -->
1212 header_fields(HdrExtra, Len),
1213 content_length(codes(Codes, utf8), Len),
1214 content_type(Type, utf8),
1215 "\r\n".
1216post_header(bytes(Type, Bytes), HdrExtra) -->
1217 header_fields(HdrExtra, Len),
1218 content_length(bytes(Bytes), Len),
1219 content_type(Type),
1220 "\r\n".
1221post_header(atom(Type, Atom), HdrExtra) -->
1222 header_fields(HdrExtra, Len),
1223 content_length(atom(Atom, utf8), Len),
1224 content_type(Type, utf8),
1225 "\r\n".
1226post_header(string(Type, String), HdrExtra) -->
1227 header_fields(HdrExtra, Len),
1228 content_length(string(String, utf8), Len),
1229 content_type(Type, utf8),
1230 "\r\n".
1231
1232
1233 1236
1241
(Out, What, HdrExtra) :-
1243 phrase(reply_header(What, HdrExtra, _Code), String),
1244 !,
1245 send_reply_header(Out, String).
1246
1268
(Data, Dict) -->
1270 { _{header:HdrExtra, code:Code} :< Dict },
1271 reply_header(Data, HdrExtra, Code).
1272
(string(String), HdrExtra, Code) -->
1274 reply_header(string(text/plain, String), HdrExtra, Code).
1275reply_header(string(Type, String), HdrExtra, Code) -->
1276 vstatus(ok, Code, HdrExtra),
1277 date(now),
1278 header_fields(HdrExtra, CLen),
1279 content_length(codes(String, utf8), CLen),
1280 content_type(Type, utf8),
1281 "\r\n".
1282reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
1283 vstatus(ok, Code, HdrExtra),
1284 date(now),
1285 header_fields(HdrExtra, CLen),
1286 content_length(bytes(Bytes), CLen),
1287 content_type(Type),
1288 "\r\n".
1289reply_header(html(Tokens), HdrExtra, Code) -->
1290 vstatus(ok, Code, HdrExtra),
1291 date(now),
1292 header_fields(HdrExtra, CLen),
1293 content_length(html(Tokens), CLen),
1294 content_type(text/html),
1295 "\r\n".
1296reply_header(file(Type, File), HdrExtra, Code) -->
1297 vstatus(ok, Code, HdrExtra),
1298 date(now),
1299 modified(file(File)),
1300 header_fields(HdrExtra, CLen),
1301 content_length(file(File), CLen),
1302 content_type(Type),
1303 "\r\n".
1304reply_header(gzip_file(Type, File), HdrExtra, Code) -->
1305 vstatus(ok, Code, HdrExtra),
1306 date(now),
1307 modified(file(File)),
1308 header_fields(HdrExtra, CLen),
1309 content_length(file(File), CLen),
1310 content_type(Type),
1311 content_encoding(gzip),
1312 "\r\n".
1313reply_header(file(Type, File, Range), HdrExtra, Code) -->
1314 vstatus(partial_content, Code, HdrExtra),
1315 date(now),
1316 modified(file(File)),
1317 header_fields(HdrExtra, CLen),
1318 content_length(file(File, Range), CLen),
1319 content_type(Type),
1320 "\r\n".
1321reply_header(tmp_file(Type, File), HdrExtra, Code) -->
1322 vstatus(ok, Code, HdrExtra),
1323 date(now),
1324 header_fields(HdrExtra, CLen),
1325 content_length(file(File), CLen),
1326 content_type(Type),
1327 "\r\n".
1328reply_header(cgi_data(Size), HdrExtra, Code) -->
1329 vstatus(ok, Code, HdrExtra),
1330 date(now),
1331 header_fields(HdrExtra, CLen),
1332 content_length(Size, CLen),
1333 "\r\n".
1334reply_header(chunked_data, HdrExtra, Code) -->
1335 vstatus(ok, Code, HdrExtra),
1336 date(now),
1337 header_fields(HdrExtra, _),
1338 ( {memberchk(transfer_encoding(_), HdrExtra)}
1339 -> ""
1340 ; transfer_encoding(chunked)
1341 ),
1342 "\r\n".
1344reply_header(status(Status), HdrExtra, Code) -->
1345 vstatus(Status, Code),
1346 header_fields(HdrExtra, Clen),
1347 { Clen = 0 },
1348 "\r\n".
1350reply_header(Data, HdrExtra, Code) -->
1351 { status_reply_headers(Data,
1352 body(Type, Encoding, Content),
1353 ReplyHeaders),
1354 http_join_headers(ReplyHeaders, HdrExtra, Headers),
1355 functor(Data, CodeName, _)
1356 },
1357 vstatus(CodeName, Code, Headers),
1358 date(now),
1359 header_fields(Headers, CLen),
1360 content_length(codes(Content, Encoding), CLen),
1361 content_type(Type, Encoding),
1362 "\r\n".
1363
(created(Location, Body), Body,
1365 [ location(Location) ]).
1366status_reply_headers(moved(To, Body), Body,
1367 [ location(To) ]).
1368status_reply_headers(moved_temporary(To, Body), Body,
1369 [ location(To) ]).
1370status_reply_headers(gone(_URL, Body), Body, []).
1371status_reply_headers(see_other(To, Body), Body,
1372 [ location(To) ]).
1373status_reply_headers(authorise(Method, Body), Body,
1374 [ www_authenticate(Method) ]).
1375status_reply_headers(not_found(_URL, Body), Body, []).
1376status_reply_headers(forbidden(_URL, Body), Body, []).
1377status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
1378status_reply_headers(server_error(_Error, Body), Body, []).
1379status_reply_headers(service_unavailable(_Why, Body), Body, []).
1380status_reply_headers(not_acceptable(_Why, Body), Body, []).
1381status_reply_headers(bad_request(_Error, Body), Body, []).
1382
1383
1388
1389vstatus(_Status, Code, HdrExtra) -->
1390 {memberchk(status(Code), HdrExtra)},
1391 !,
1392 vstatus(_NewStatus, Code).
1393vstatus(Status, Code, _) -->
1394 vstatus(Status, Code).
1395
1396vstatus(Status, Code) -->
1397 "HTTP/1.1 ",
1398 status_number(Status, Code),
1399 " ",
1400 status_comment(Status),
1401 "\r\n".
1402
1409
1410status_number(Status, Code) -->
1411 { var(Status) },
1412 !,
1413 integer(Code),
1414 { status_number(Status, Code) },
1415 !.
1416status_number(Status, Code) -->
1417 { status_number(Status, Code) },
1418 integer(Code).
1419
1431
1439
1440status_number(Status, Code) :-
1441 nonvar(Status),
1442 !,
1443 status_number_fact(Status, Code).
1444status_number(Status, Code) :-
1445 nonvar(Code),
1446 !,
1447 ( between(100, 599, Code)
1448 -> ( status_number_fact(Status, Code)
1449 -> true
1450 ; ClassCode is Code // 100 * 100,
1451 status_number_fact(Status, ClassCode)
1452 )
1453 ; domain_error(http_code, Code)
1454 ).
1455
1456status_number_fact(continue, 100).
1457status_number_fact(switching_protocols, 101).
1458status_number_fact(ok, 200).
1459status_number_fact(created, 201).
1460status_number_fact(accepted, 202).
1461status_number_fact(non_authoritative_info, 203).
1462status_number_fact(no_content, 204).
1463status_number_fact(reset_content, 205).
1464status_number_fact(partial_content, 206).
1465status_number_fact(multiple_choices, 300).
1466status_number_fact(moved, 301).
1467status_number_fact(moved_temporary, 302).
1468status_number_fact(see_other, 303).
1469status_number_fact(not_modified, 304).
1470status_number_fact(use_proxy, 305).
1471status_number_fact(unused, 306).
1472status_number_fact(temporary_redirect, 307).
1473status_number_fact(bad_request, 400).
1474status_number_fact(authorise, 401).
1475status_number_fact(payment_required, 402).
1476status_number_fact(forbidden, 403).
1477status_number_fact(not_found, 404).
1478status_number_fact(method_not_allowed, 405).
1479status_number_fact(not_acceptable, 406).
1480status_number_fact(request_timeout, 408).
1481status_number_fact(conflict, 409).
1482status_number_fact(gone, 410).
1483status_number_fact(length_required, 411).
1484status_number_fact(payload_too_large, 413).
1485status_number_fact(uri_too_long, 414).
1486status_number_fact(unsupported_media_type, 415).
1487status_number_fact(expectation_failed, 417).
1488status_number_fact(upgrade_required, 426).
1489status_number_fact(server_error, 500).
1490status_number_fact(not_implemented, 501).
1491status_number_fact(bad_gateway, 502).
1492status_number_fact(service_unavailable, 503).
1493status_number_fact(gateway_timeout, 504).
1494status_number_fact(http_version_not_supported, 505).
1495
1496
1500
(continue) -->
1502 "Continue".
1503status_comment(switching_protocols) -->
1504 "Switching Protocols".
1505status_comment(ok) -->
1506 "OK".
1507status_comment(created) -->
1508 "Created".
1509status_comment(accepted) -->
1510 "Accepted".
1511status_comment(non_authoritative_info) -->
1512 "Non-Authoritative Information".
1513status_comment(no_content) -->
1514 "No Content".
1515status_comment(reset_content) -->
1516 "Reset Content".
1517status_comment(created) -->
1518 "Created".
1519status_comment(partial_content) -->
1520 "Partial content".
1521status_comment(multiple_choices) -->
1522 "Multiple Choices".
1523status_comment(moved) -->
1524 "Moved Permanently".
1525status_comment(moved_temporary) -->
1526 "Moved Temporary".
1527status_comment(see_other) -->
1528 "See Other".
1529status_comment(not_modified) -->
1530 "Not Modified".
1531status_comment(use_proxy) -->
1532 "Use Proxy".
1533status_comment(unused) -->
1534 "Unused".
1535status_comment(temporary_redirect) -->
1536 "Temporary Redirect".
1537status_comment(bad_request) -->
1538 "Bad Request".
1539status_comment(authorise) -->
1540 "Authorization Required".
1541status_comment(payment_required) -->
1542 "Payment Required".
1543status_comment(forbidden) -->
1544 "Forbidden".
1545status_comment(not_found) -->
1546 "Not Found".
1547status_comment(method_not_allowed) -->
1548 "Method Not Allowed".
1549status_comment(not_acceptable) -->
1550 "Not Acceptable".
1551status_comment(request_timeout) -->
1552 "Request Timeout".
1553status_comment(conflict) -->
1554 "Conflict".
1555status_comment(gone) -->
1556 "Gone".
1557status_comment(length_required) -->
1558 "Length Required".
1559status_comment(payload_too_large) -->
1560 "Payload Too Large".
1561status_comment(uri_too_long) -->
1562 "URI Too Long".
1563status_comment(unsupported_media_type) -->
1564 "Unsupported Media Type".
1565status_comment(expectation_failed) -->
1566 "Expectation Failed".
1567status_comment(upgrade_required) -->
1568 "Upgrade Required".
1569status_comment(server_error) -->
1570 "Internal Server Error".
1571status_comment(not_implemented) -->
1572 "Not Implemented".
1573status_comment(bad_gateway) -->
1574 "Bad Gateway".
1575status_comment(service_unavailable) -->
1576 "Service Unavailable".
1577status_comment(gateway_timeout) -->
1578 "Gateway Timeout".
1579status_comment(http_version_not_supported) -->
1580 "HTTP Version Not Supported".
1581
1582date(Time) -->
1583 "Date: ",
1584 ( { Time == now }
1585 -> now
1586 ; rfc_date(Time)
1587 ),
1588 "\r\n".
1589
1590modified(file(File)) -->
1591 !,
1592 { time_file(File, Time)
1593 },
1594 modified(Time).
1595modified(Time) -->
1596 "Last-modified: ",
1597 ( { Time == now }
1598 -> now
1599 ; rfc_date(Time)
1600 ),
1601 "\r\n".
1602
1603
1610
1611content_length(file(File, bytes(From, To)), Len) -->
1612 !,
1613 { size_file(File, Size),
1614 ( To == end
1615 -> Len is Size - From,
1616 RangeEnd is Size - 1
1617 ; Len is To+1 - From, 1618 RangeEnd = To
1619 )
1620 },
1621 content_range(bytes, From, RangeEnd, Size),
1622 content_length(Len, Len).
1623content_length(Reply, Len) -->
1624 { length_of(Reply, Len)
1625 },
1626 "Content-Length: ", integer(Len),
1627 "\r\n".
1628
1629
1630length_of(_, Len) :-
1631 nonvar(Len),
1632 !.
1633length_of(string(String, Encoding), Len) :-
1634 length_of(codes(String, Encoding), Len).
1635length_of(codes(String, Encoding), Len) :-
1636 !,
1637 setup_call_cleanup(
1638 open_null_stream(Out),
1639 ( set_stream(Out, encoding(Encoding)),
1640 format(Out, '~s', [String]),
1641 byte_count(Out, Len)
1642 ),
1643 close(Out)).
1644length_of(atom(Atom, Encoding), Len) :-
1645 !,
1646 setup_call_cleanup(
1647 open_null_stream(Out),
1648 ( set_stream(Out, encoding(Encoding)),
1649 format(Out, '~a', [Atom]),
1650 byte_count(Out, Len)
1651 ),
1652 close(Out)).
1653length_of(file(File), Len) :-
1654 !,
1655 size_file(File, Len).
1656length_of(memory_file(Handle), Len) :-
1657 !,
1658 size_memory_file(Handle, Len, octet).
1659length_of(html_tokens(Tokens), Len) :-
1660 !,
1661 html_print_length(Tokens, Len).
1662length_of(html(Tokens), Len) :- 1663 !,
1664 html_print_length(Tokens, Len).
1665length_of(bytes(Bytes), Len) :-
1666 !,
1667 ( string(Bytes)
1668 -> string_length(Bytes, Len)
1669 ; length(Bytes, Len) 1670 ).
1671length_of(Len, Len).
1672
1673
1678
1679content_range(Unit, From, RangeEnd, Size) -->
1680 "Content-Range: ", atom(Unit), " ",
1681 integer(From), "-", integer(RangeEnd), "/", integer(Size),
1682 "\r\n".
1683
1684content_encoding(Encoding) -->
1685 "Content-Encoding: ", atom(Encoding), "\r\n".
1686
1687transfer_encoding(Encoding) -->
1688 "Transfer-Encoding: ", atom(Encoding), "\r\n".
1689
1690content_type(Type) -->
1691 content_type(Type, _).
1692
1693content_type(Type, Charset) -->
1694 ctype(Type),
1695 charset(Charset),
1696 "\r\n".
1697
1698ctype(Main/Sub) -->
1699 !,
1700 "Content-Type: ",
1701 atom(Main),
1702 "/",
1703 atom(Sub).
1704ctype(Type) -->
1705 !,
1706 "Content-Type: ",
1707 atom(Type).
1708
1709charset(Var) -->
1710 { var(Var) },
1711 !.
1712charset(utf8) -->
1713 !,
1714 "; charset=UTF-8".
1715charset(CharSet) -->
1716 "; charset=",
1717 atom(CharSet).
1718
1724
(Name, Value) -->
1726 { var(Name) }, 1727 !,
1728 field_name(Name),
1729 ":",
1730 whites,
1731 read_field_value(ValueChars),
1732 blanks_to_nl,
1733 !,
1734 { field_to_prolog(Name, ValueChars, Value)
1735 -> true
1736 ; atom_codes(Value, ValueChars),
1737 domain_error(Name, Value)
1738 }.
1739header_field(Name, Value) -->
1740 field_name(Name),
1741 ": ",
1742 field_value(Name, Value),
1743 "\r\n".
1744
1748
1749read_field_value([H|T]) -->
1750 [H],
1751 { \+ code_type(H, space) },
1752 !,
1753 read_field_value(T).
1754read_field_value([]) -->
1755 "".
1756read_field_value([H|T]) -->
1757 [H],
1758 read_field_value(T).
1759
1764
(Out, String) :-
1766 debug(http(send_reply), "< ~s", [String]),
1767 format(Out, '~s', [String]).
1768
(Out, String) :-
1770 debug(http(send_request), "> ~s", [String]),
1771 format(Out, '~s', [String]).
1772
1810
(Field, Value, Prolog) :-
1812 known_field(Field, _, Type),
1813 ( already_parsed(Type, Value)
1814 -> Prolog = Value
1815 ; to_codes(Value, Codes),
1816 parse_header_value(Field, Codes, Prolog)
1817 ).
1818
1819already_parsed(integer, V) :- !, integer(V).
1820already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
1821already_parsed(Term, V) :- subsumes_term(Term, V).
1822
1823
1828
1829known_field(content_length, true, integer).
1830known_field(status, true, integer).
1831known_field(cookie, true, list(_=_)).
1832known_field(set_cookie, true, list(set_cookie(_Name,_Value,_Options))).
1833known_field(host, true, _Host:_Port).
1834known_field(range, maybe, bytes(_,_)).
1835known_field(accept, maybe, list(media(_Type, _Parms, _Q, _Exts))).
1836known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
1837known_field(content_type, false, media(_Type/_Sub, _Attributes)).
1838
1839to_codes(In, Codes) :-
1840 ( is_list(In)
1841 -> Codes = In
1842 ; atom_codes(In, Codes)
1843 ).
1844
1850
1851field_to_prolog(Field, Codes, Prolog) :-
1852 known_field(Field, true, _Type),
1853 !,
1854 ( parse_header_value(Field, Codes, Prolog0)
1855 -> Prolog = Prolog0
1856 ).
1857field_to_prolog(Field, Codes, Prolog) :-
1858 known_field(Field, maybe, _Type),
1859 parse_header_value(Field, Codes, Prolog0),
1860 !,
1861 Prolog = Prolog0.
1862field_to_prolog(_, Codes, Atom) :-
1863 atom_codes(Atom, Codes).
1864
1869
(content_length, ValueChars, ContentLength) :-
1871 number_codes(ContentLength, ValueChars).
1872parse_header_value(status, ValueChars, Code) :-
1873 ( phrase(" ", L, _),
1874 append(Pre, L, ValueChars)
1875 -> number_codes(Code, Pre)
1876 ; number_codes(Code, ValueChars)
1877 ).
1878parse_header_value(cookie, ValueChars, Cookies) :-
1879 debug(cookie, 'Cookie: ~s', [ValueChars]),
1880 phrase(cookies(Cookies), ValueChars).
1881parse_header_value(set_cookie, ValueChars, SetCookie) :-
1882 debug(cookie, 'SetCookie: ~s', [ValueChars]),
1883 phrase(set_cookie(SetCookie), ValueChars).
1884parse_header_value(host, ValueChars, Host) :-
1885 ( append(HostChars, [0':|PortChars], ValueChars),
1886 catch(number_codes(Port, PortChars), _, fail)
1887 -> atom_codes(HostName, HostChars),
1888 Host = HostName:Port
1889 ; atom_codes(Host, ValueChars)
1890 ).
1891parse_header_value(range, ValueChars, Range) :-
1892 phrase(range(Range), ValueChars).
1893parse_header_value(accept, ValueChars, Media) :-
1894 parse_accept(ValueChars, Media).
1895parse_header_value(content_disposition, ValueChars, Disposition) :-
1896 phrase(content_disposition(Disposition), ValueChars).
1897parse_header_value(content_type, ValueChars, Type) :-
1898 phrase(parse_content_type(Type), ValueChars).
1899
1901
1902field_value(_, set_cookie(Name, Value, Options)) -->
1903 !,
1904 atom(Name), "=", atom(Value),
1905 value_options(Options, cookie).
1906field_value(_, disposition(Disposition, Options)) -->
1907 !,
1908 atom(Disposition), value_options(Options, disposition).
1909field_value(www_authenticate, Auth) -->
1910 auth_field_value(Auth).
1911field_value(_, Atomic) -->
1912 atom(Atomic).
1913
1917
1918auth_field_value(negotiate(Data)) -->
1919 "Negotiate ",
1920 { base64(Data, DataBase64),
1921 atom_codes(DataBase64, Codes)
1922 },
1923 string(Codes).
1924auth_field_value(negotiate) -->
1925 "Negotiate".
1926auth_field_value(basic) -->
1927 !,
1928 "Basic".
1929auth_field_value(basic(Realm)) -->
1930 "Basic Realm=\"", atom(Realm), "\"".
1931auth_field_value(digest) -->
1932 !,
1933 "Digest".
1934auth_field_value(digest(Details)) -->
1935 "Digest ", atom(Details).
1936
1943
1944value_options([], _) --> [].
1945value_options([H|T], Field) -->
1946 "; ", value_option(H, Field),
1947 value_options(T, Field).
1948
1949value_option(secure=true, cookie) -->
1950 !,
1951 "secure".
1952value_option(Name=Value, Type) -->
1953 { string_option(Name, Type) },
1954 !,
1955 atom(Name), "=",
1956 qstring(Value).
1957value_option(Name=Value, Type) -->
1958 { token_option(Name, Type) },
1959 !,
1960 atom(Name), "=", atom(Value).
1961value_option(Name=Value, _Type) -->
1962 atom(Name), "=",
1963 option_value(Value).
1964
1965string_option(filename, disposition).
1966
1967token_option(path, cookie).
1968
1969option_value(Value) -->
1970 { number(Value) },
1971 !,
1972 number(Value).
1973option_value(Value) -->
1974 { ( atom(Value)
1975 -> true
1976 ; string(Value)
1977 ),
1978 forall(string_code(_, Value, C),
1979 token_char(C))
1980 },
1981 !,
1982 atom(Value).
1983option_value(Atomic) -->
1984 qstring(Atomic).
1985
1986qstring(Atomic) -->
1987 { string_codes(Atomic, Codes) },
1988 "\"",
1989 qstring_codes(Codes),
1990 "\"".
1991
1992qstring_codes([]) --> [].
1993qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
1994
1995qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
1996qstring_code(C) --> [C].
1997
1998qstring_esc(0'").
1999qstring_esc(C) :- ctl(C).
2000
2001
2002 2005
2006:- dynamic accept_cache/2. 2007:- volatile accept_cache/2. 2008
2009parse_accept(Codes, Media) :-
2010 atom_codes(Atom, Codes),
2011 ( accept_cache(Atom, Media0)
2012 -> Media = Media0
2013 ; phrase(accept(Media0), Codes),
2014 keysort(Media0, Media1),
2015 pairs_values(Media1, Media2),
2016 assertz(accept_cache(Atom, Media2)),
2017 Media = Media2
2018 ).
2019
2023
2024accept([H|T]) -->
2025 blanks,
2026 media_range(H),
2027 blanks,
2028 ( ","
2029 -> accept(T)
2030 ; {T=[]}
2031 ).
2032
2033media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
2034 media_type(Type),
2035 blanks,
2036 ( ";"
2037 -> blanks,
2038 parameters_and_quality(TypeParams, Quality, AcceptExts)
2039 ; { TypeParams = [],
2040 Quality = 1.0,
2041 AcceptExts = []
2042 }
2043 ),
2044 { SortQuality is float(-Quality),
2045 rank_specialised(Type, TypeParams, Spec)
2046 }.
2047
2048
2052
2053content_disposition(disposition(Disposition, Options)) -->
2054 token(Disposition), blanks,
2055 value_parameters(Options).
2056
2061
2062parse_content_type(media(Type, Parameters)) -->
2063 media_type(Type), blanks,
2064 value_parameters(Parameters).
2065
2066
2074
2075rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
2076 var_or_given(Type, VT),
2077 var_or_given(SubType, VS),
2078 length(TypeParams, VP),
2079 SortVP is -VP.
2080
2081var_or_given(V, Val) :-
2082 ( var(V)
2083 -> Val = 0
2084 ; Val = -1
2085 ).
2086
2087media_type(Type/SubType) -->
2088 type(Type), "/", type(SubType).
2089
2090type(_) -->
2091 "*",
2092 !.
2093type(Type) -->
2094 token(Type).
2095
2096parameters_and_quality(Params, Quality, AcceptExts) -->
2097 token(Name),
2098 blanks, "=", blanks,
2099 ( { Name == q }
2100 -> float(Quality), blanks,
2101 value_parameters(AcceptExts),
2102 { Params = [] }
2103 ; { Params = [Name=Value|T] },
2104 parameter_value(Value),
2105 blanks,
2106 ( ";"
2107 -> blanks,
2108 parameters_and_quality(T, Quality, AcceptExts)
2109 ; { T = [],
2110 Quality = 1.0,
2111 AcceptExts = []
2112 }
2113 )
2114 ).
2115
2120
2121value_parameters([H|T]) -->
2122 ";",
2123 !,
2124 blanks, token(Name), blanks,
2125 ( "="
2126 -> blanks,
2127 ( token(Value)
2128 -> []
2129 ; quoted_string(Value)
2130 ),
2131 { H = (Name=Value) }
2132 ; { H = Name }
2133 ),
2134 blanks,
2135 value_parameters(T).
2136value_parameters([]) -->
2137 [].
2138
2139parameter_value(Value) --> token(Value), !.
2140parameter_value(Value) --> quoted_string(Value).
2141
2142
2146
2147token(Name) -->
2148 token_char(C1),
2149 token_chars(Cs),
2150 { atom_codes(Name, [C1|Cs]) }.
2151
2152token_chars([H|T]) -->
2153 token_char(H),
2154 !,
2155 token_chars(T).
2156token_chars([]) --> [].
2157
2158token_char(C) :-
2159 \+ ctl(C),
2160 \+ separator_code(C).
2161
2162ctl(C) :- between(0,31,C), !.
2163ctl(127).
2164
2165separator_code(0'().
2166separator_code(0')).
2167separator_code(0'<).
2168separator_code(0'>).
2169separator_code(0'@).
2170separator_code(0',).
2171separator_code(0';).
2172separator_code(0':).
2173separator_code(0'\\).
2174separator_code(0'").
2175separator_code(0'/).
2176separator_code(0'[).
2177separator_code(0']).
2178separator_code(0'?).
2179separator_code(0'=).
2180separator_code(0'{).
2181separator_code(0'}).
2182separator_code(0'\s).
2183separator_code(0'\t).
2184
2185term_expansion(token_char(x) --> [x], Clauses) :-
2186 findall((token_char(C)-->[C]),
2187 ( between(0, 255, C),
2188 token_char(C)
2189 ),
2190 Clauses).
2191
2192token_char(x) --> [x].
2193
2197
2198quoted_string(Text) -->
2199 "\"",
2200 quoted_text(Codes),
2201 { atom_codes(Text, Codes) }.
2202
2203quoted_text([]) -->
2204 "\"",
2205 !.
2206quoted_text([H|T]) -->
2207 "\\", !, [H],
2208 quoted_text(T).
2209quoted_text([H|T]) -->
2210 [H],
2211 !,
2212 quoted_text(T).
2213
2214
2222
([], _) --> [].
2224header_fields([content_length(CLen)|T], CLen) -->
2225 !,
2226 ( { var(CLen) }
2227 -> ""
2228 ; header_field(content_length, CLen)
2229 ),
2230 header_fields(T, CLen). 2231header_fields([status(_)|T], CLen) --> 2232 !,
2233 header_fields(T, CLen).
2234header_fields([H|T], CLen) -->
2235 { H =.. [Name, Value] },
2236 header_field(Name, Value),
2237 header_fields(T, CLen).
2238
2239
2253
2254:- public
2255 field_name//1. 2256
2257field_name(Name) -->
2258 { var(Name) },
2259 !,
2260 rd_field_chars(Chars),
2261 { atom_codes(Name, Chars) }.
2262field_name(mime_version) -->
2263 !,
2264 "MIME-Version".
2265field_name(www_authenticate) -->
2266 !,
2267 "WWW-Authenticate".
2268field_name(Name) -->
2269 { atom_codes(Name, Chars) },
2270 wr_field_chars(Chars).
2271
2272rd_field_chars_no_fold([C|T]) -->
2273 [C],
2274 { rd_field_char(C, _) },
2275 !,
2276 rd_field_chars_no_fold(T).
2277rd_field_chars_no_fold([]) -->
2278 [].
2279
2280rd_field_chars([C0|T]) -->
2281 [C],
2282 { rd_field_char(C, C0) },
2283 !,
2284 rd_field_chars(T).
2285rd_field_chars([]) -->
2286 [].
2287
2291
2292separators("()<>@,;:\\\"/[]?={} \t").
2293
2294term_expansion(rd_field_char('expand me',_), Clauses) :-
2295
2296 Clauses = [ rd_field_char(0'-, 0'_)
2297 | Cls
2298 ],
2299 separators(SepString),
2300 string_codes(SepString, Seps),
2301 findall(rd_field_char(In, Out),
2302 ( between(32, 127, In),
2303 \+ memberchk(In, Seps),
2304 In \== 0'-, 2305 code_type(Out, to_lower(In))),
2306 Cls).
2307
2308rd_field_char('expand me', _). 2309
2310wr_field_chars([C|T]) -->
2311 !,
2312 { code_type(C, to_lower(U)) },
2313 [U],
2314 wr_field_chars2(T).
2315wr_field_chars([]) -->
2316 [].
2317
2318wr_field_chars2([]) --> [].
2319wr_field_chars2([C|T]) --> 2320 ( { C == 0'_ }
2321 -> "-",
2322 wr_field_chars(T)
2323 ; [C],
2324 wr_field_chars2(T)
2325 ).
2326
2330
2331now -->
2332 { get_time(Time)
2333 },
2334 rfc_date(Time).
2335
2340
2341rfc_date(Time, String, Tail) :-
2342 stamp_date_time(Time, Date, 'UTC'),
2343 format_time(codes(String, Tail),
2344 '%a, %d %b %Y %T GMT',
2345 Date, posix).
2346
2350
2351http_timestamp(Time, Atom) :-
2352 stamp_date_time(Time, Date, 'UTC'),
2353 format_time(atom(Atom),
2354 '%a, %d %b %Y %T GMT',
2355 Date, posix).
2356
2357
2358 2361
2362request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
2363 method(Method),
2364 blanks,
2365 nonblanks(Query),
2366 { atom_codes(ReqURI, Query),
2367 request_uri_parts(ReqURI, Header, Rest)
2368 },
2369 request_header(Fd, Rest),
2370 !.
2371request(Fd, [unknown(What)|Header]) -->
2372 string(What),
2373 eos,
2374 !,
2375 { http_read_header(Fd, Header)
2376 -> true
2377 ; Header = []
2378 }.
2379
2380method(get) --> "GET", !.
2381method(put) --> "PUT", !.
2382method(head) --> "HEAD", !.
2383method(post) --> "POST", !.
2384method(delete) --> "DELETE", !.
2385method(patch) --> "PATCH", !.
2386method(options) --> "OPTIONS", !.
2387method(trace) --> "TRACE", !.
2388
2400
2401request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
2402 uri_components(ReqURI, Components),
2403 uri_data(path, Components, PathText),
2404 uri_encoded(path, Path, PathText),
2405 phrase(uri_parts(Components), Parts, Rest).
2406
2407uri_parts(Components) -->
2408 uri_search(Components),
2409 uri_fragment(Components).
2410
2411uri_search(Components) -->
2412 { uri_data(search, Components, Search),
2413 nonvar(Search),
2414 catch(uri_query_components(Search, Query),
2415 error(syntax_error(_),_),
2416 fail)
2417 },
2418 !,
2419 [ search(Query) ].
2420uri_search(_) --> [].
2421
2422uri_fragment(Components) -->
2423 { uri_data(fragment, Components, String),
2424 nonvar(String),
2425 !,
2426 uri_encoded(fragment, Fragment, String)
2427 },
2428 [ fragment(Fragment) ].
2429uri_fragment(_) --> [].
2430
2435
(_, []) --> 2437 blanks,
2438 eos,
2439 !.
2440request_header(Fd, [http_version(Version)|Header]) -->
2441 http_version(Version),
2442 blanks,
2443 eos,
2444 !,
2445 { Version = 1-_
2446 -> http_read_header(Fd, Header)
2447 ; Header = []
2448 }.
2449
2450http_version(Version) -->
2451 blanks,
2452 "HTTP/",
2453 http_version_number(Version).
2454
2455http_version_number(Major-Minor) -->
2456 integer(Major),
2457 ".",
2458 integer(Minor).
2459
2460
2461 2464
2468
2469cookies([Name=Value|T]) -->
2470 blanks,
2471 cookie(Name, Value),
2472 !,
2473 blanks,
2474 ( ";"
2475 -> cookies(T)
2476 ; { T = [] }
2477 ).
2478cookies(List) -->
2479 string(Skipped),
2480 ";",
2481 !,
2482 { print_message(warning, http(skipped_cookie(Skipped))) },
2483 cookies(List).
2484cookies([]) -->
2485 blanks.
2486
2487cookie(Name, Value) -->
2488 cookie_name(Name),
2489 blanks, "=", blanks,
2490 cookie_value(Value).
2491
2492cookie_name(Name) -->
2493 { var(Name) },
2494 !,
2495 rd_field_chars_no_fold(Chars),
2496 { atom_codes(Name, Chars) }.
2497
2498cookie_value(Value) -->
2499 quoted_string(Value),
2500 !.
2501cookie_value(Value) -->
2502 chars_to_semicolon_or_blank(Chars),
2503 { atom_codes(Value, Chars)
2504 }.
2505
2506chars_to_semicolon_or_blank([]), ";" -->
2507 ";",
2508 !.
2509chars_to_semicolon_or_blank([]) -->
2510 " ",
2511 blanks,
2512 eos,
2513 !.
2514chars_to_semicolon_or_blank([H|T]) -->
2515 [H],
2516 !,
2517 chars_to_semicolon_or_blank(T).
2518chars_to_semicolon_or_blank([]) -->
2519 [].
2520
2521set_cookie(set_cookie(Name, Value, Options)) -->
2522 ws,
2523 cookie(Name, Value),
2524 cookie_options(Options).
2525
2526cookie_options([H|T]) -->
2527 ws,
2528 ";",
2529 ws,
2530 cookie_option(H),
2531 !,
2532 cookie_options(T).
2533cookie_options([]) -->
2534 ws.
2535
2536ws --> " ", !, ws.
2537ws --> [].
2538
2539
2548
2549cookie_option(Name=Value) -->
2550 rd_field_chars(NameChars), ws,
2551 { atom_codes(Name, NameChars) },
2552 ( "="
2553 -> ws,
2554 chars_to_semicolon(ValueChars),
2555 { atom_codes(Value, ValueChars)
2556 }
2557 ; { Value = true }
2558 ).
2559
2560chars_to_semicolon([H|T]) -->
2561 [H],
2562 { H \== 32, H \== 0'; },
2563 !,
2564 chars_to_semicolon(T).
2565chars_to_semicolon([]), ";" -->
2566 ws, ";",
2567 !.
2568chars_to_semicolon([H|T]) -->
2569 [H],
2570 chars_to_semicolon(T).
2571chars_to_semicolon([]) -->
2572 [].
2573
2581
2582range(bytes(From, To)) -->
2583 "bytes", whites, "=", whites, integer(From), "-",
2584 ( integer(To)
2585 -> ""
2586 ; { To = end }
2587 ).
2588
2589
2590 2593
2608
2609reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
2610 http_version(HttpVersion),
2611 blanks,
2612 ( status_number(Status, Code)
2613 -> []
2614 ; integer(Status)
2615 ),
2616 blanks,
2617 string(CommentCodes),
2618 blanks_to_nl,
2619 !,
2620 blanks,
2621 { atom_codes(Comment, CommentCodes),
2622 http_read_header(Fd, Header)
2623 }.
2624
2625
2626 2629
2635
(Fd, Header) :-
2637 read_header_data(Fd, Text),
2638 http_parse_header(Text, Header).
2639
(Fd, Header) :-
2641 read_line_to_codes(Fd, Header, Tail),
2642 read_header_data(Header, Fd, Tail),
2643 debug(http(header), 'Header = ~n~s~n', [Header]).
2644
([0'\r,0'\n], _, _) :- !.
2646read_header_data([0'\n], _, _) :- !.
2647read_header_data([], _, _) :- !.
2648read_header_data(_, Fd, Tail) :-
2649 read_line_to_codes(Fd, Tail, NewTail),
2650 read_header_data(Tail, Fd, NewTail).
2651
2658
(Text, Header) :-
2660 phrase(header(Header), Text),
2661 debug(http(header), 'Field: ~p', [Header]).
2662
(List) -->
2664 header_field(Name, Value),
2665 !,
2666 { mkfield(Name, Value, List, Tail)
2667 },
2668 blanks,
2669 header(Tail).
2670header([]) -->
2671 blanks,
2672 eos,
2673 !.
2674header(_) -->
2675 string(S), blanks_to_nl,
2676 !,
2677 { string_codes(Line, S),
2678 syntax_error(http_parameter(Line))
2679 }.
2680
2692
2693:- multifile
2694 http:http_address//0. 2695
2696address -->
2697 http:http_address,
2698 !.
2699address -->
2700 { gethostname(Host) },
2701 html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
2702 ' httpd at ', Host
2703 ])).
2704
2705mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
2706mkfield(Name, Value, [Att|Tail], Tail) :-
2707 Att =.. [Name, Value].
2708
2714
2744
2745
2746 2749
2750:- multifile
2751 prolog:message//1,
2752 prolog:error_message//1. 2753
2754prolog:error_message(http_write_short(Data, Sent)) -->
2755 data(Data),
2756 [ ': remote hangup after ~D bytes'-[Sent] ].
2757prolog:error_message(syntax_error(http_request(Request))) -->
2758 [ 'Illegal HTTP request: ~s'-[Request] ].
2759prolog:error_message(syntax_error(http_parameter(Line))) -->
2760 [ 'Illegal HTTP parameter: ~s'-[Line] ].
2761
2762prolog:message(http(skipped_cookie(S))) -->
2763 [ 'Skipped illegal cookie: ~s'-[S] ].
2764
2765data(bytes(MimeType, _Bytes)) -->
2766 !,
2767 [ 'bytes(~p, ...)'-[MimeType] ].
2768data(Data) -->
2769 [ '~p'-[Data] ]