36
37:- module(http_header,
38 [ http_read_request/2, 39 http_read_reply_header/2, 40 http_reply/2, 41 http_reply/3, 42 http_reply/4, 43 http_reply/5, 44 45 http_reply/6, 46 47 http_reply_header/3, 48 http_status_reply/4, 49 http_status_reply/5, 50 51
52 http_timestamp/2, 53
54 http_post_data/3, 55
56 http_read_header/2, 57 http_parse_header/2, 58 http_parse_header_value/3, 59 http_join_headers/3, 60 http_update_encoding/3, 61 http_update_connection/4, 62 http_update_transfer/4 63 ]). 64:- autoload(html_write,
65 [ print_html/2, print_html/1, page/4, html/3,
66 html_print_length/2
67 ]). 68:- if(exists_source(http_exception)). 69:- autoload(http_exception,[map_exception_to_http_status/4]). 70:- endif. 71:- autoload(mimepack,[mime_pack/3]). 72:- autoload(mimetype,[file_mime_type/2]). 73:- autoload(library(apply),[maplist/2]). 74:- autoload(library(base64),[base64/2]). 75:- use_module(library(debug),[debug/3,debugging/1]). 76:- autoload(library(error),[syntax_error/1,domain_error/2]). 77:- autoload(library(lists),[append/3,member/2,select/3,delete/3]). 78:- autoload(library(memfile),
79 [ new_memory_file/1, open_memory_file/3,
80 free_memory_file/1, open_memory_file/4,
81 size_memory_file/3
82 ]). 83:- autoload(library(option),[option/3,option/2]). 84:- autoload(library(pairs),[pairs_values/2]). 85:- autoload(library(readutil),
86 [read_line_to_codes/2,read_line_to_codes/3]). 87:- autoload(library(sgml_write),[xml_write/3]). 88:- autoload(library(socket),[gethostname/1]). 89:- autoload(library(uri),
90 [ uri_components/2, uri_data/3, uri_encoded/3, uri_query_components/2
91 ]). 92:- autoload(library(url),[parse_url_search/2]). 93:- autoload(library(dcg/basics),
94 [ integer/3, atom/3, whites/2, blanks_to_nl/2, string/3,
95 number/3, blanks/2, float/3, nonblanks/3, eos/2
96 ]). 97:- autoload(library(date), [parse_time/3]). 98:- use_module(library(settings),[setting/4,setting/2]). 99
100:- multifile
101 http:status_page/3, 102 http:status_reply/3, 103 http:serialize_reply/2, 104 http:post_data_hook/3, 105 http:mime_type_encoding/2. 106
108
109:- setting(http:chunked_transfer, oneof([never,on_request,if_possible]),
110 on_request, 'When to use Transfer-Encoding: Chunked'). 111
112
119
120:- discontiguous
121 term_expansion/2. 122
123
124 127
133
134http_read_request(In, Request) :-
135 catch(read_line_to_codes(In, Codes), E, true),
136 ( var(E)
137 -> ( Codes == end_of_file
138 -> debug(http(header), 'end-of-file', []),
139 Request = end_of_file
140 ; debug(http(header), 'First line: ~s', [Codes]),
141 Request = [input(In)|Request1],
142 phrase(request(In, Request1), Codes),
143 ( Request1 = [unknown(Text)|_]
144 -> string_codes(S, Text),
145 syntax_error(http_request(S))
146 ; true
147 )
148 )
149 ; ( debugging(http(request))
150 -> message_to_string(E, Msg),
151 debug(http(request), "Exception reading 1st line: ~s", [Msg])
152 ; true
153 ),
154 Request = end_of_file
155 ).
156
157
162
(In, [input(In)|Reply]) :-
164 read_line_to_codes(In, Codes),
165 ( Codes == end_of_file
166 -> debug(http(header), 'end-of-file', []),
167 throw(error(syntax(http_reply_header, end_of_file), _))
168 ; debug(http(header), 'First line: ~s~n', [Codes]),
169 ( phrase(reply(In, Reply), Codes)
170 -> true
171 ; atom_codes(Header, Codes),
172 syntax_error(http_reply_header(Header))
173 )
174 ).
175
176
177 180
227
228http_reply(What, Out) :-
229 http_reply(What, Out, [connection(close)], _).
230
231http_reply(Data, Out, HdrExtra) :-
232 http_reply(Data, Out, HdrExtra, _Code).
233
234http_reply(Data, Out, HdrExtra, Code) :-
235 http_reply(Data, Out, HdrExtra, [], Code).
236
237http_reply(Data, Out, HdrExtra, Context, Code) :-
238 http_reply(Data, Out, HdrExtra, Context, [method(get)], Code).
239
240http_reply(Data, Out, HdrExtra, _Context, Request, Code) :-
241 byte_count(Out, C0),
242 memberchk(method(Method), Request),
243 catch(http_reply_data(Data, Out, HdrExtra, Method, Code), E, true),
244 !,
245 ( var(E)
246 -> true
247 ; ( E = error(io_error(write,_), _)
248 ; E = error(socket_error(_,_), _)
249 )
250 -> byte_count(Out, C1),
251 Sent is C1 - C0,
252 throw(error(http_write_short(Data, Sent), _))
253 ; E = error(timeout_error(write, _), _)
254 -> throw(E)
255 ; map_exception_to_http_status(E, Status, NewHdr, NewContext)
256 -> http_status_reply(Status, Out, NewHdr, NewContext, Request, Code)
257 ; throw(E)
258 ).
259http_reply(Status, Out, HdrExtra, Context, Request, Code) :-
260 http_status_reply(Status, Out, HdrExtra, Context, Request, Code).
261
262:- if(\+current_predicate(map_exception_to_http_status/4)). 263map_exception_to_http_status(_E, _Status, _NewHdr, _NewContext) :-
264 fail.
265:- endif. 266
267:- meta_predicate
268 if_no_head(0, +). 269
276
277http_reply_data(Data, Out, HdrExtra, Method, Code) :-
278 http_reply_data_(Data, Out, HdrExtra, Method, Code),
279 flush_output(Out).
280
281http_reply_data_(html(HTML), Out, HdrExtra, Method, Code) :-
282 !,
283 phrase(reply_header(html(HTML), HdrExtra, Code), Header),
284 send_reply_header(Out, Header),
285 if_no_head(print_html(Out, HTML), Method).
286http_reply_data_(file(Type, File), Out, HdrExtra, Method, Code) :-
287 !,
288 phrase(reply_header(file(Type, File), HdrExtra, Code), Header),
289 reply_file(Out, File, Header, Method).
290http_reply_data_(gzip_file(Type, File), Out, HdrExtra, Method, Code) :-
291 !,
292 phrase(reply_header(gzip_file(Type, File), HdrExtra, Code), Header),
293 reply_file(Out, File, Header, Method).
294http_reply_data_(file(Type, File, Range), Out, HdrExtra, Method, Code) :-
295 !,
296 phrase(reply_header(file(Type, File, Range), HdrExtra, Code), Header),
297 reply_file_range(Out, File, Header, Range, Method).
298http_reply_data_(tmp_file(Type, File), Out, HdrExtra, Method, Code) :-
299 !,
300 phrase(reply_header(tmp_file(Type, File), HdrExtra, Code), Header),
301 reply_file(Out, File, Header, Method).
302http_reply_data_(bytes(Type, Bytes), Out, HdrExtra, Method, Code) :-
303 !,
304 phrase(reply_header(bytes(Type, Bytes), HdrExtra, Code), Header),
305 send_reply_header(Out, Header),
306 if_no_head(format(Out, '~s', [Bytes]), Method).
307http_reply_data_(stream(In, Len), Out, HdrExtra, Method, Code) :-
308 !,
309 phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header),
310 copy_stream(Out, In, Header, Method, 0, end).
311http_reply_data_(cgi_stream(In, Len), Out, HdrExtra, Method, Code) :-
312 !,
313 http_read_header(In, CgiHeader),
314 seek(In, 0, current, Pos),
315 Size is Len - Pos,
316 http_join_headers(HdrExtra, CgiHeader, Hdr2),
317 phrase(reply_header(cgi_data(Size), Hdr2, Code), Header),
318 copy_stream(Out, In, Header, Method, 0, end).
319
320if_no_head(_, head) :-
321 !.
322if_no_head(Goal, _) :-
323 call(Goal).
324
325reply_file(Out, _File, Header, head) :-
326 !,
327 send_reply_header(Out, Header).
328reply_file(Out, File, Header, _) :-
329 setup_call_cleanup(
330 open(File, read, In, [type(binary)]),
331 copy_stream(Out, In, Header, 0, end),
332 close(In)).
333
334reply_file_range(Out, _File, Header, _Range, head) :-
335 !,
336 send_reply_header(Out, Header).
337reply_file_range(Out, File, Header, bytes(From, To), _) :-
338 setup_call_cleanup(
339 open(File, read, In, [type(binary)]),
340 copy_stream(Out, In, Header, From, To),
341 close(In)).
342
343copy_stream(Out, _, Header, head, _, _) :-
344 !,
345 send_reply_header(Out, Header).
346copy_stream(Out, In, Header, _, From, To) :-
347 copy_stream(Out, In, Header, From, To).
348
349copy_stream(Out, In, Header, From, To) :-
350 ( From == 0
351 -> true
352 ; seek(In, From, bof, _)
353 ),
354 peek_byte(In, _),
355 send_reply_header(Out, Header),
356 ( To == end
357 -> copy_stream_data(In, Out)
358 ; Len is To - From,
359 copy_stream_data(In, Out, Len)
360 ).
361
362
393
394http_status_reply(Status, Out, Options) :-
395 _{header:HdrExtra, context:Context, code:Code, method:Method} :< Options,
396 http_status_reply(Status, Out, HdrExtra, Context, [method(Method)], Code).
397
398http_status_reply(Status, Out, HdrExtra, Code) :-
399 http_status_reply(Status, Out, HdrExtra, [], Code).
400
401http_status_reply(Status, Out, HdrExtra, Context, Code) :-
402 http_status_reply(Status, Out, HdrExtra, Context, [method(get)], Code).
403
404http_status_reply(Status, Out, HdrExtra, Context, Request, Code) :-
405 option(method(Method), Request, get),
406 parsed_accept(Request, Accept),
407 status_reply_flush(Status, Out,
408 _{ context: Context,
409 method: Method,
410 code: Code,
411 accept: Accept,
412 header: HdrExtra
413 }).
414
415parsed_accept(Request, Accept) :-
416 memberchk(accept(Accept0), Request),
417 http_parse_header_value(accept, Accept0, Accept1),
418 !,
419 Accept = Accept1.
420parsed_accept(_, [ media(text/html, [], 0.1, []),
421 media(_, [], 0.01, [])
422 ]).
423
424status_reply_flush(Status, Out, Options) :-
425 status_reply(Status, Out, Options),
426 !,
427 flush_output(Out).
428
439
441status_reply(no_content, Out, Options) :-
442 !,
443 phrase(reply_header(status(no_content), Options), Header),
444 send_reply_header(Out, Header).
445status_reply(switching_protocols(_Goal,SwitchOptions), Out, Options) :-
446 !,
447 ( option(headers(Extra1), SwitchOptions)
448 -> true
449 ; option(header(Extra1), SwitchOptions, [])
450 ),
451 http_join_headers(Options.header, Extra1, HdrExtra),
452 phrase(reply_header(status(switching_protocols),
453 Options.put(header,HdrExtra)), Header),
454 send_reply_header(Out, Header).
455status_reply(authorise(basic, ''), Out, Options) :-
456 !,
457 status_reply(authorise(basic), Out, Options).
458status_reply(authorise(basic, Realm), Out, Options) :-
459 !,
460 status_reply(authorise(basic(Realm)), Out, Options).
461status_reply(not_modified, Out, Options) :-
462 !,
463 phrase(reply_header(status(not_modified), Options), Header),
464 send_reply_header(Out, Header).
466status_reply(busy, Out, Options) :-
467 status_reply(service_unavailable(busy), Out, Options).
468status_reply(unavailable(Why), Out, Options) :-
469 status_reply(service_unavailable(Why), Out, Options).
470status_reply(resource_error(Why), Out, Options) :-
471 status_reply(service_unavailable(Why), Out, Options).
473status_reply(Status, Out, Options) :-
474 status_has_content(Status),
475 status_page_hook(Status, Reply, Options),
476 serialize_body(Reply, Body),
477 Status =.. List,
478 append(List, [Body], ExList),
479 ExStatus =.. ExList,
480 phrase(reply_header(ExStatus, Options), Header),
481 send_reply_header(Out, Header),
482 reply_status_body(Out, Body, Options).
483
488
489status_has_content(created(_Location)).
490status_has_content(moved(_To)).
491status_has_content(moved_temporary(_To)).
492status_has_content(gone(_URL)).
493status_has_content(see_other(_To)).
494status_has_content(bad_request(_ErrorTerm)).
495status_has_content(authorise(_Method)).
496status_has_content(forbidden(_URL)).
497status_has_content(not_found(_URL)).
498status_has_content(method_not_allowed(_Method, _URL)).
499status_has_content(not_acceptable(_Why)).
500status_has_content(server_error(_ErrorTerm)).
501status_has_content(service_unavailable(_Why)).
502
511
512serialize_body(Reply, Body) :-
513 http:serialize_reply(Reply, Body),
514 !.
515serialize_body(html_tokens(Tokens), body(text/html, utf8, Content)) :-
516 !,
517 with_output_to(string(Content), print_html(Tokens)).
518serialize_body(Reply, Reply) :-
519 Reply = body(_,_,_),
520 !.
521serialize_body(Reply, _) :-
522 domain_error(http_reply_body, Reply).
523
524reply_status_body(_, _, Options) :-
525 Options.method == head,
526 !.
527reply_status_body(Out, body(_Type, Encoding, Content), _Options) :-
528 ( Encoding == octet
529 -> format(Out, '~s', [Content])
530 ; setup_call_cleanup(
531 set_stream(Out, encoding(Encoding)),
532 format(Out, '~s', [Content]),
533 set_stream(Out, encoding(octet)))
534 ).
535
545
560
561status_page_hook(Term, Reply, Options) :-
562 Context = Options.context,
563 functor(Term, Name, _),
564 status_number_fact(Name, Code),
565 ( Options.code = Code,
566 http:status_reply(Term, Reply, Options)
567 ; http:status_page(Term, Context, HTML),
568 Reply = html_tokens(HTML)
569 ; http:status_page(Code, Context, HTML), 570 Reply = html_tokens(HTML)
571 ),
572 !.
573status_page_hook(created(Location), html_tokens(HTML), _Options) :-
574 phrase(page([ title('201 Created')
575 ],
576 [ h1('Created'),
577 p(['The document was created ',
578 a(href(Location), ' Here')
579 ]),
580 \address
581 ]),
582 HTML).
583status_page_hook(moved(To), html_tokens(HTML), _Options) :-
584 phrase(page([ title('301 Moved Permanently')
585 ],
586 [ h1('Moved Permanently'),
587 p(['The document has moved ',
588 a(href(To), ' Here')
589 ]),
590 \address
591 ]),
592 HTML).
593status_page_hook(moved_temporary(To), html_tokens(HTML), _Options) :-
594 phrase(page([ title('302 Moved Temporary')
595 ],
596 [ h1('Moved Temporary'),
597 p(['The document is currently ',
598 a(href(To), ' Here')
599 ]),
600 \address
601 ]),
602 HTML).
603status_page_hook(gone(URL), html_tokens(HTML), _Options) :-
604 phrase(page([ title('410 Resource Gone')
605 ],
606 [ h1('Resource Gone'),
607 p(['The document has been removed ',
608 a(href(URL), ' from here')
609 ]),
610 \address
611 ]),
612 HTML).
613status_page_hook(see_other(To), html_tokens(HTML), _Options) :-
614 phrase(page([ title('303 See Other')
615 ],
616 [ h1('See Other'),
617 p(['See other document ',
618 a(href(To), ' Here')
619 ]),
620 \address
621 ]),
622 HTML).
623status_page_hook(bad_request(ErrorTerm), html_tokens(HTML), _Options) :-
624 '$messages':translate_message(ErrorTerm, Lines, []),
625 phrase(page([ title('400 Bad Request')
626 ],
627 [ h1('Bad Request'),
628 p(\html_message_lines(Lines)),
629 \address
630 ]),
631 HTML).
632status_page_hook(authorise(_Method), html_tokens(HTML), _Options):-
633 phrase(page([ title('401 Authorization Required')
634 ],
635 [ h1('Authorization Required'),
636 p(['This server could not verify that you ',
637 'are authorized to access the document ',
638 'requested. Either you supplied the wrong ',
639 'credentials (e.g., bad password), or your ',
640 'browser doesn\'t understand how to supply ',
641 'the credentials required.'
642 ]),
643 \address
644 ]),
645 HTML).
646status_page_hook(forbidden(URL), html_tokens(HTML), _Options) :-
647 phrase(page([ title('403 Forbidden')
648 ],
649 [ h1('Forbidden'),
650 p(['You don\'t have permission to access ', URL,
651 ' on this server'
652 ]),
653 \address
654 ]),
655 HTML).
656status_page_hook(not_found(URL), html_tokens(HTML), _Options) :-
657 phrase(page([ title('404 Not Found')
658 ],
659 [ h1('Not Found'),
660 p(['The requested URL ', tt(URL),
661 ' was not found on this server'
662 ]),
663 \address
664 ]),
665 HTML).
666status_page_hook(method_not_allowed(Method,URL), html_tokens(HTML), _Options) :-
667 upcase_atom(Method, UMethod),
668 phrase(page([ title('405 Method not allowed')
669 ],
670 [ h1('Method not allowed'),
671 p(['The requested URL ', tt(URL),
672 ' does not support method ', tt(UMethod), '.'
673 ]),
674 \address
675 ]),
676 HTML).
677status_page_hook(not_acceptable(WhyHTML), html_tokens(HTML), _Options) :-
678 phrase(page([ title('406 Not Acceptable')
679 ],
680 [ h1('Not Acceptable'),
681 WhyHTML,
682 \address
683 ]),
684 HTML).
685status_page_hook(server_error(ErrorTerm), html_tokens(HTML), _Options) :-
686 '$messages':translate_message(ErrorTerm, Lines, []),
687 phrase(page([ title('500 Internal server error')
688 ],
689 [ h1('Internal server error'),
690 p(\html_message_lines(Lines)),
691 \address
692 ]),
693 HTML).
694status_page_hook(service_unavailable(Why), html_tokens(HTML), _Options) :-
695 phrase(page([ title('503 Service Unavailable')
696 ],
697 [ h1('Service Unavailable'),
698 \unavailable(Why),
699 \address
700 ]),
701 HTML).
702
703unavailable(busy) -->
704 html(p(['The server is temporarily out of resources, ',
705 'please try again later'])).
706unavailable(error(Formal,Context)) -->
707 { '$messages':translate_message(error(Formal,Context), Lines, []) },
708 html_message_lines(Lines).
709unavailable(HTML) -->
710 html(HTML).
711
712html_message_lines([]) -->
713 [].
714html_message_lines([nl|T]) -->
715 !,
716 html([br([])]),
717 html_message_lines(T).
718html_message_lines([flush]) -->
719 [].
720html_message_lines([ansi(_Style,Fmt,Args)|T]) -->
721 !,
722 { format(string(S), Fmt, Args)
723 },
724 html([S]),
725 html_message_lines(T).
726html_message_lines([url(Pos)|T]) -->
727 !,
728 msg_url(Pos),
729 html_message_lines(T).
730html_message_lines([url(URL, Label)|T]) -->
731 !,
732 html(a(href(URL), Label)),
733 html_message_lines(T).
734html_message_lines([Fmt-Args|T]) -->
735 !,
736 { format(string(S), Fmt, Args)
737 },
738 html([S]),
739 html_message_lines(T).
740html_message_lines([Fmt|T]) -->
741 !,
742 { format(string(S), Fmt, [])
743 },
744 html([S]),
745 html_message_lines(T).
746
747msg_url(File:Line:Pos) -->
748 !,
749 html([File, :, Line, :, Pos]).
750msg_url(File:Line) -->
751 !,
752 html([File, :, Line]).
753msg_url(File) -->
754 html([File]).
755
760
([], H, H).
762http_join_headers([H|T], Hdr0, Hdr) :-
763 functor(H, N, A),
764 functor(H2, N, A),
765 member(H2, Hdr0),
766 !,
767 http_join_headers(T, Hdr0, Hdr).
768http_join_headers([H|T], Hdr0, [H|Hdr]) :-
769 http_join_headers(T, Hdr0, Hdr).
770
771
780
781http_update_encoding(Header0, Encoding, Header) :-
782 memberchk(content_type(Type), Header0),
783 !,
784 http_update_encoding(Type, Header0, Encoding, Header).
785http_update_encoding(Header, octet, Header).
786
787http_update_encoding('text/event-stream', Header, utf8, Header) :-
788 !.
789http_update_encoding(Type0, Header0, utf8, [content_type(Type)|Header]) :-
790 sub_atom(Type0, 0, _, _, 'text/'),
791 !,
792 select(content_type(_), Header0, Header),
793 !,
794 ( sub_atom(Type0, S, _, _, ';')
795 -> sub_atom(Type0, 0, S, _, B)
796 ; B = Type0
797 ),
798 atom_concat(B, '; charset=UTF-8', Type).
799http_update_encoding(Type, Header, Encoding, Header) :-
800 ( sub_atom_icasechk(Type, _, 'utf-8')
801 -> Encoding = utf8
802 ; http:mime_type_encoding(Type, Encoding)
803 -> true
804 ; mime_type_encoding(Type, Encoding)
805 -> true
806 ; Encoding = octet
807 ).
808
813
814mime_type_encoding('application/json', utf8).
815mime_type_encoding('application/jsonrequest', utf8).
816mime_type_encoding('application/x-prolog', utf8).
817mime_type_encoding('application/n-quads', utf8).
818mime_type_encoding('application/n-triples', utf8).
819mime_type_encoding('application/sparql-query', utf8).
820mime_type_encoding('application/trig', utf8).
821mime_type_encoding('application/sparql-results+json', utf8).
822mime_type_encoding('application/sparql-results+xml', utf8).
823
831
832
837
838http_update_connection(CgiHeader, Request, Connect,
839 [connection(Connect)|Rest]) :-
840 select(connection(CgiConn), CgiHeader, Rest),
841 !,
842 connection(Request, ReqConnection),
843 join_connection(ReqConnection, CgiConn, Connect).
844http_update_connection(CgiHeader, Request, Connect,
845 [connection(Connect)|CgiHeader]) :-
846 connection(Request, Connect).
847
848join_connection(Keep1, Keep2, Connection) :-
849 ( downcase_atom(Keep1, 'keep-alive'),
850 downcase_atom(Keep2, 'keep-alive')
851 -> Connection = 'Keep-Alive'
852 ; Connection = close
853 ).
854
855
859
860connection(Header, Close) :-
861 ( memberchk(connection(Connection), Header)
862 -> Close = Connection
863 ; memberchk(http_version(1-X), Header),
864 X >= 1
865 -> Close = 'Keep-Alive'
866 ; Close = close
867 ).
868
869
885
886http_update_transfer(Request, CgiHeader, Transfer, Header) :-
887 setting(http:chunked_transfer, When),
888 http_update_transfer(When, Request, CgiHeader, Transfer, Header).
889
890http_update_transfer(never, _, CgiHeader, none, Header) :-
891 !,
892 delete(CgiHeader, transfer_encoding(_), Header).
893http_update_transfer(_, _, CgiHeader, none, Header) :-
894 memberchk(location(_), CgiHeader),
895 !,
896 delete(CgiHeader, transfer_encoding(_), Header).
897http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
898 select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
899 !,
900 transfer(Request, ReqConnection),
901 join_transfer(ReqConnection, CgiTransfer, Transfer),
902 ( Transfer == none
903 -> Header = Rest
904 ; Header = [transfer_encoding(Transfer)|Rest]
905 ).
906http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
907 transfer(Request, Transfer),
908 Transfer \== none,
909 !,
910 Header = [transfer_encoding(Transfer)|CgiHeader].
911http_update_transfer(_, _, CgiHeader, event_stream, CgiHeader) :-
912 memberchk(content_type('text/event-stream'), CgiHeader),
913 !.
914http_update_transfer(_, _, CgiHeader, none, CgiHeader).
915
916join_transfer(chunked, chunked, chunked) :- !.
917join_transfer(_, _, none).
918
919
923
924transfer(Header, Transfer) :-
925 ( memberchk(transfer_encoding(Transfer0), Header)
926 -> Transfer = Transfer0
927 ; memberchk(http_version(1-X), Header),
928 X >= 1
929 -> Transfer = chunked
930 ; Transfer = none
931 ).
932
933
939
940content_length_in_encoding(Enc, Stream, Bytes) :-
941 stream_property(Stream, position(Here)),
942 setup_call_cleanup(
943 open_null_stream(Out),
944 ( set_stream(Out, encoding(Enc)),
945 catch(copy_stream_data(Stream, Out), _, fail),
946 flush_output(Out),
947 byte_count(Out, Bytes)
948 ),
949 ( close(Out, [force(true)]),
950 set_stream_position(Stream, Here)
951 )).
952
953
954 957
1063
1064http_post_data(Data, Out, HdrExtra) :-
1065 http:post_data_hook(Data, Out, HdrExtra),
1066 !.
1067http_post_data(html(HTML), Out, HdrExtra) :-
1068 !,
1069 phrase(post_header(html(HTML), HdrExtra), Header),
1070 send_request_header(Out, Header),
1071 print_html(Out, HTML).
1072http_post_data(xml(XML), Out, HdrExtra) :-
1073 !,
1074 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
1075http_post_data(xml(Type, XML), Out, HdrExtra) :-
1076 !,
1077 http_post_data(xml(Type, XML, []), Out, HdrExtra).
1078http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
1079 !,
1080 setup_call_cleanup(
1081 new_memory_file(MemFile),
1082 ( setup_call_cleanup(
1083 open_memory_file(MemFile, write, MemOut),
1084 xml_write(MemOut, XML, Options),
1085 close(MemOut)),
1086 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
1087 ),
1088 free_memory_file(MemFile)).
1089http_post_data(file(File), Out, HdrExtra) :-
1090 !,
1091 ( file_mime_type(File, Type)
1092 -> true
1093 ; Type = text/plain
1094 ),
1095 http_post_data(file(Type, File), Out, HdrExtra).
1096http_post_data(file(Type, File), Out, HdrExtra) :-
1097 !,
1098 phrase(post_header(file(Type, File), HdrExtra), Header),
1099 send_request_header(Out, Header),
1100 setup_call_cleanup(
1101 open(File, read, In, [type(binary)]),
1102 copy_stream_data(In, Out),
1103 close(In)).
1104http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
1105 !,
1106 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1107 send_request_header(Out, Header),
1108 setup_call_cleanup(
1109 open_memory_file(Handle, read, In, [encoding(octet)]),
1110 copy_stream_data(In, Out),
1111 close(In)).
1112http_post_data(codes(Codes), Out, HdrExtra) :-
1113 !,
1114 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1115http_post_data(codes(Type, Codes), Out, HdrExtra) :-
1116 !,
1117 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1118 send_request_header(Out, Header),
1119 setup_call_cleanup(
1120 set_stream(Out, encoding(utf8)),
1121 format(Out, '~s', [Codes]),
1122 set_stream(Out, encoding(octet))).
1123http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
1124 !,
1125 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1126 send_request_header(Out, Header),
1127 format(Out, '~s', [Bytes]).
1128http_post_data(atom(Atom), Out, HdrExtra) :-
1129 !,
1130 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1131http_post_data(atom(Type, Atom), Out, HdrExtra) :-
1132 !,
1133 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1134 send_request_header(Out, Header),
1135 setup_call_cleanup(
1136 set_stream(Out, encoding(utf8)),
1137 write(Out, Atom),
1138 set_stream(Out, encoding(octet))).
1139http_post_data(string(String), Out, HdrExtra) :-
1140 !,
1141 http_post_data(atom(text/plain, String), Out, HdrExtra).
1142http_post_data(string(Type, String), Out, HdrExtra) :-
1143 !,
1144 phrase(post_header(string(Type, String), HdrExtra), Header),
1145 send_request_header(Out, Header),
1146 setup_call_cleanup(
1147 set_stream(Out, encoding(utf8)),
1148 write(Out, String),
1149 set_stream(Out, encoding(octet))).
1150http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
1151 !,
1152 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1153 http_post_data(cgi_stream(In), Out, HdrExtra).
1154http_post_data(cgi_stream(In), Out, HdrExtra) :-
1155 !,
1156 http_read_header(In, Header0),
1157 http_update_encoding(Header0, Encoding, Header),
1158 content_length_in_encoding(Encoding, In, Size),
1159 http_join_headers(HdrExtra, Header, Hdr2),
1160 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1161 send_request_header(Out, HeaderText),
1162 setup_call_cleanup(
1163 set_stream(Out, encoding(Encoding)),
1164 copy_stream_data(In, Out),
1165 set_stream(Out, encoding(octet))).
1166http_post_data(form(Fields), Out, HdrExtra) :-
1167 !,
1168 parse_url_search(Codes, Fields),
1169 length(Codes, Size),
1170 http_join_headers(HdrExtra,
1171 [ content_type('application/x-www-form-urlencoded')
1172 ], Header),
1173 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1174 send_request_header(Out, HeaderChars),
1175 format(Out, '~s', [Codes]).
1176http_post_data(form_data(Data), Out, HdrExtra) :-
1177 !,
1178 setup_call_cleanup(
1179 new_memory_file(MemFile),
1180 ( setup_call_cleanup(
1181 open_memory_file(MemFile, write, MimeOut),
1182 mime_pack(Data, MimeOut, Boundary),
1183 close(MimeOut)),
1184 size_memory_file(MemFile, Size, octet),
1185 format(string(ContentType),
1186 'multipart/form-data; boundary=~w', [Boundary]),
1187 http_join_headers(HdrExtra,
1188 [ mime_version('1.0'),
1189 content_type(ContentType)
1190 ], Header),
1191 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1192 send_request_header(Out, HeaderChars),
1193 setup_call_cleanup(
1194 open_memory_file(MemFile, read, In, [encoding(octet)]),
1195 copy_stream_data(In, Out),
1196 close(In))
1197 ),
1198 free_memory_file(MemFile)).
1199http_post_data(List, Out, HdrExtra) :- 1200 is_list(List),
1201 !,
1202 setup_call_cleanup(
1203 new_memory_file(MemFile),
1204 ( setup_call_cleanup(
1205 open_memory_file(MemFile, write, MimeOut),
1206 mime_pack(List, MimeOut, Boundary),
1207 close(MimeOut)),
1208 size_memory_file(MemFile, Size, octet),
1209 format(string(ContentType),
1210 'multipart/mixed; boundary=~w', [Boundary]),
1211 http_join_headers(HdrExtra,
1212 [ mime_version('1.0'),
1213 content_type(ContentType)
1214 ], Header),
1215 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1216 send_request_header(Out, HeaderChars),
1217 setup_call_cleanup(
1218 open_memory_file(MemFile, read, In, [encoding(octet)]),
1219 copy_stream_data(In, Out),
1220 close(In))
1221 ),
1222 free_memory_file(MemFile)).
1223
1228
(html(Tokens), HdrExtra) -->
1230 header_fields(HdrExtra, Len),
1231 content_length(html(Tokens), Len),
1232 content_type(text/html),
1233 "\r\n".
1234post_header(file(Type, File), HdrExtra) -->
1235 header_fields(HdrExtra, Len),
1236 content_length(file(File), Len),
1237 content_type(Type),
1238 "\r\n".
1239post_header(memory_file(Type, File), HdrExtra) -->
1240 header_fields(HdrExtra, Len),
1241 content_length(memory_file(File), Len),
1242 content_type(Type),
1243 "\r\n".
1244post_header(cgi_data(Size), HdrExtra) -->
1245 header_fields(HdrExtra, Len),
1246 content_length(Size, Len),
1247 "\r\n".
1248post_header(codes(Type, Codes), HdrExtra) -->
1249 header_fields(HdrExtra, Len),
1250 content_length(codes(Codes, utf8), Len),
1251 content_type(Type, utf8),
1252 "\r\n".
1253post_header(bytes(Type, Bytes), HdrExtra) -->
1254 header_fields(HdrExtra, Len),
1255 content_length(bytes(Bytes), Len),
1256 content_type(Type),
1257 "\r\n".
1258post_header(atom(Type, Atom), HdrExtra) -->
1259 header_fields(HdrExtra, Len),
1260 content_length(atom(Atom, utf8), Len),
1261 content_type(Type, utf8),
1262 "\r\n".
1263post_header(string(Type, String), HdrExtra) -->
1264 header_fields(HdrExtra, Len),
1265 content_length(string(String, utf8), Len),
1266 content_type(Type, utf8),
1267 "\r\n".
1268
1269
1270 1273
1278
(Out, What, HdrExtra) :-
1280 phrase(reply_header(What, HdrExtra, _Code), String),
1281 !,
1282 send_reply_header(Out, String).
1283
1305
(Data, Dict) -->
1307 { _{header:HdrExtra, code:Code} :< Dict },
1308 reply_header(Data, HdrExtra, Code).
1309
(string(String), HdrExtra, Code) -->
1311 reply_header(string(text/plain, String), HdrExtra, Code).
1312reply_header(string(Type, String), HdrExtra, Code) -->
1313 vstatus(ok, Code, HdrExtra),
1314 date(now),
1315 header_fields(HdrExtra, CLen),
1316 content_length(codes(String, utf8), CLen),
1317 content_type(Type, utf8),
1318 "\r\n".
1319reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
1320 vstatus(ok, Code, HdrExtra),
1321 date(now),
1322 header_fields(HdrExtra, CLen),
1323 content_length(bytes(Bytes), CLen),
1324 content_type(Type),
1325 "\r\n".
1326reply_header(html(Tokens), HdrExtra, Code) -->
1327 vstatus(ok, Code, HdrExtra),
1328 date(now),
1329 header_fields(HdrExtra, CLen),
1330 content_length(html(Tokens), CLen),
1331 content_type(text/html),
1332 "\r\n".
1333reply_header(file(Type, File), HdrExtra, Code) -->
1334 vstatus(ok, Code, HdrExtra),
1335 date(now),
1336 modified(file(File)),
1337 header_fields(HdrExtra, CLen),
1338 content_length(file(File), CLen),
1339 content_type(Type),
1340 "\r\n".
1341reply_header(gzip_file(Type, File), HdrExtra, Code) -->
1342 vstatus(ok, Code, HdrExtra),
1343 date(now),
1344 modified(file(File)),
1345 header_fields(HdrExtra, CLen),
1346 content_length(file(File), CLen),
1347 content_type(Type),
1348 content_encoding(gzip),
1349 "\r\n".
1350reply_header(file(Type, File, Range), HdrExtra, Code) -->
1351 vstatus(partial_content, Code, HdrExtra),
1352 date(now),
1353 modified(file(File)),
1354 header_fields(HdrExtra, CLen),
1355 content_length(file(File, Range), CLen),
1356 content_type(Type),
1357 "\r\n".
1358reply_header(tmp_file(Type, File), HdrExtra, Code) -->
1359 vstatus(ok, Code, HdrExtra),
1360 date(now),
1361 header_fields(HdrExtra, CLen),
1362 content_length(file(File), CLen),
1363 content_type(Type),
1364 "\r\n".
1365reply_header(cgi_data(Size), HdrExtra, Code) -->
1366 vstatus(ok, Code, HdrExtra),
1367 date(now),
1368 header_fields(HdrExtra, CLen),
1369 content_length(Size, CLen),
1370 "\r\n".
1371reply_header(event_stream, HdrExtra, Code) -->
1372 vstatus(ok, Code, HdrExtra),
1373 date(now),
1374 header_fields(HdrExtra, _),
1375 "\r\n".
1376reply_header(chunked_data, HdrExtra, Code) -->
1377 vstatus(ok, Code, HdrExtra),
1378 date(now),
1379 header_fields(HdrExtra, _),
1380 ( {memberchk(transfer_encoding(_), HdrExtra)}
1381 -> ""
1382 ; transfer_encoding(chunked)
1383 ),
1384 "\r\n".
1386reply_header(status(Status), HdrExtra, Code) -->
1387 vstatus(Status, Code),
1388 header_fields(HdrExtra, Clen),
1389 { Clen = 0 },
1390 "\r\n".
1392reply_header(Data, HdrExtra, Code) -->
1393 { status_reply_headers(Data,
1394 body(Type, Encoding, Content),
1395 ReplyHeaders),
1396 http_join_headers(ReplyHeaders, HdrExtra, Headers),
1397 functor(Data, CodeName, _)
1398 },
1399 vstatus(CodeName, Code, Headers),
1400 date(now),
1401 header_fields(Headers, CLen),
1402 content_length(codes(Content, Encoding), CLen),
1403 content_type(Type, Encoding),
1404 "\r\n".
1405
(created(Location, Body), Body,
1407 [ location(Location) ]).
1408status_reply_headers(moved(To, Body), Body,
1409 [ location(To) ]).
1410status_reply_headers(moved_temporary(To, Body), Body,
1411 [ location(To) ]).
1412status_reply_headers(gone(_URL, Body), Body, []).
1413status_reply_headers(see_other(To, Body), Body,
1414 [ location(To) ]).
1415status_reply_headers(authorise(Method, Body), Body,
1416 [ www_authenticate(Method) ]).
1417status_reply_headers(not_found(_URL, Body), Body, []).
1418status_reply_headers(forbidden(_URL, Body), Body, []).
1419status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
1420status_reply_headers(server_error(_Error, Body), Body, []).
1421status_reply_headers(service_unavailable(_Why, Body), Body, []).
1422status_reply_headers(not_acceptable(_Why, Body), Body, []).
1423status_reply_headers(bad_request(_Error, Body), Body, []).
1424
1425
1430
1431vstatus(_Status, Code, HdrExtra) -->
1432 {memberchk(status(Code), HdrExtra)},
1433 !,
1434 vstatus(_NewStatus, Code).
1435vstatus(Status, Code, _) -->
1436 vstatus(Status, Code).
1437
1438vstatus(Status, Code) -->
1439 "HTTP/1.1 ",
1440 status_number(Status, Code),
1441 " ",
1442 status_comment(Status),
1443 "\r\n".
1444
1451
1452status_number(Status, Code) -->
1453 { var(Status) },
1454 !,
1455 integer(Code),
1456 { status_number(Status, Code) },
1457 !.
1458status_number(Status, Code) -->
1459 { status_number(Status, Code) },
1460 integer(Code).
1461
1473
1481
1482status_number(Status, Code) :-
1483 nonvar(Status),
1484 !,
1485 status_number_fact(Status, Code).
1486status_number(Status, Code) :-
1487 nonvar(Code),
1488 !,
1489 ( between(100, 599, Code)
1490 -> ( status_number_fact(Status, Code)
1491 -> true
1492 ; ClassCode is Code // 100 * 100,
1493 status_number_fact(Status, ClassCode)
1494 )
1495 ; domain_error(http_code, Code)
1496 ).
1497
1498status_number_fact(continue, 100).
1499status_number_fact(switching_protocols, 101).
1500status_number_fact(ok, 200).
1501status_number_fact(created, 201).
1502status_number_fact(accepted, 202).
1503status_number_fact(non_authoritative_info, 203).
1504status_number_fact(no_content, 204).
1505status_number_fact(reset_content, 205).
1506status_number_fact(partial_content, 206).
1507status_number_fact(multiple_choices, 300).
1508status_number_fact(moved, 301).
1509status_number_fact(moved_temporary, 302).
1510status_number_fact(see_other, 303).
1511status_number_fact(not_modified, 304).
1512status_number_fact(use_proxy, 305).
1513status_number_fact(unused, 306).
1514status_number_fact(temporary_redirect, 307).
1515status_number_fact(bad_request, 400).
1516status_number_fact(authorise, 401).
1517status_number_fact(payment_required, 402).
1518status_number_fact(forbidden, 403).
1519status_number_fact(not_found, 404).
1520status_number_fact(method_not_allowed, 405).
1521status_number_fact(not_acceptable, 406).
1522status_number_fact(request_timeout, 408).
1523status_number_fact(conflict, 409).
1524status_number_fact(gone, 410).
1525status_number_fact(length_required, 411).
1526status_number_fact(payload_too_large, 413).
1527status_number_fact(uri_too_long, 414).
1528status_number_fact(unsupported_media_type, 415).
1529status_number_fact(expectation_failed, 417).
1530status_number_fact(upgrade_required, 426).
1531status_number_fact(server_error, 500).
1532status_number_fact(not_implemented, 501).
1533status_number_fact(bad_gateway, 502).
1534status_number_fact(service_unavailable, 503).
1535status_number_fact(gateway_timeout, 504).
1536status_number_fact(http_version_not_supported, 505).
1537
1538
1542
(continue) -->
1544 "Continue".
1545status_comment(switching_protocols) -->
1546 "Switching Protocols".
1547status_comment(ok) -->
1548 "OK".
1549status_comment(created) -->
1550 "Created".
1551status_comment(accepted) -->
1552 "Accepted".
1553status_comment(non_authoritative_info) -->
1554 "Non-Authoritative Information".
1555status_comment(no_content) -->
1556 "No Content".
1557status_comment(reset_content) -->
1558 "Reset Content".
1559status_comment(created) -->
1560 "Created".
1561status_comment(partial_content) -->
1562 "Partial content".
1563status_comment(multiple_choices) -->
1564 "Multiple Choices".
1565status_comment(moved) -->
1566 "Moved Permanently".
1567status_comment(moved_temporary) -->
1568 "Moved Temporary".
1569status_comment(see_other) -->
1570 "See Other".
1571status_comment(not_modified) -->
1572 "Not Modified".
1573status_comment(use_proxy) -->
1574 "Use Proxy".
1575status_comment(unused) -->
1576 "Unused".
1577status_comment(temporary_redirect) -->
1578 "Temporary Redirect".
1579status_comment(bad_request) -->
1580 "Bad Request".
1581status_comment(authorise) -->
1582 "Authorization Required".
1583status_comment(payment_required) -->
1584 "Payment Required".
1585status_comment(forbidden) -->
1586 "Forbidden".
1587status_comment(not_found) -->
1588 "Not Found".
1589status_comment(method_not_allowed) -->
1590 "Method Not Allowed".
1591status_comment(not_acceptable) -->
1592 "Not Acceptable".
1593status_comment(request_timeout) -->
1594 "Request Timeout".
1595status_comment(conflict) -->
1596 "Conflict".
1597status_comment(gone) -->
1598 "Gone".
1599status_comment(length_required) -->
1600 "Length Required".
1601status_comment(payload_too_large) -->
1602 "Payload Too Large".
1603status_comment(uri_too_long) -->
1604 "URI Too Long".
1605status_comment(unsupported_media_type) -->
1606 "Unsupported Media Type".
1607status_comment(expectation_failed) -->
1608 "Expectation Failed".
1609status_comment(upgrade_required) -->
1610 "Upgrade Required".
1611status_comment(server_error) -->
1612 "Internal Server Error".
1613status_comment(not_implemented) -->
1614 "Not Implemented".
1615status_comment(bad_gateway) -->
1616 "Bad Gateway".
1617status_comment(service_unavailable) -->
1618 "Service Unavailable".
1619status_comment(gateway_timeout) -->
1620 "Gateway Timeout".
1621status_comment(http_version_not_supported) -->
1622 "HTTP Version Not Supported".
1623
1624date(Time) -->
1625 "Date: ",
1626 ( { Time == now }
1627 -> now
1628 ; rfc_date(Time)
1629 ),
1630 "\r\n".
1631
1632modified(file(File)) -->
1633 !,
1634 { time_file(File, Time)
1635 },
1636 modified(Time).
1637modified(Time) -->
1638 "Last-modified: ",
1639 ( { Time == now }
1640 -> now
1641 ; rfc_date(Time)
1642 ),
1643 "\r\n".
1644
1645
1652
1653content_length(file(File, bytes(From, To)), Len) -->
1654 !,
1655 { size_file(File, Size),
1656 ( To == end
1657 -> Len is Size - From,
1658 RangeEnd is Size - 1
1659 ; Len is To+1 - From, 1660 RangeEnd = To
1661 )
1662 },
1663 content_range(bytes, From, RangeEnd, Size),
1664 content_length(Len, Len).
1665content_length(Reply, Len) -->
1666 { length_of(Reply, Len)
1667 },
1668 "Content-Length: ", integer(Len),
1669 "\r\n".
1670
1671
1672length_of(_, Len) :-
1673 nonvar(Len),
1674 !.
1675length_of(string(String, Encoding), Len) :-
1676 length_of(codes(String, Encoding), Len).
1677length_of(codes(String, Encoding), Len) :-
1678 !,
1679 setup_call_cleanup(
1680 open_null_stream(Out),
1681 ( set_stream(Out, encoding(Encoding)),
1682 format(Out, '~s', [String]),
1683 byte_count(Out, Len)
1684 ),
1685 close(Out)).
1686length_of(atom(Atom, Encoding), Len) :-
1687 !,
1688 setup_call_cleanup(
1689 open_null_stream(Out),
1690 ( set_stream(Out, encoding(Encoding)),
1691 format(Out, '~a', [Atom]),
1692 byte_count(Out, Len)
1693 ),
1694 close(Out)).
1695length_of(file(File), Len) :-
1696 !,
1697 size_file(File, Len).
1698length_of(memory_file(Handle), Len) :-
1699 !,
1700 size_memory_file(Handle, Len, octet).
1701length_of(html_tokens(Tokens), Len) :-
1702 !,
1703 html_print_length(Tokens, Len).
1704length_of(html(Tokens), Len) :- 1705 !,
1706 html_print_length(Tokens, Len).
1707length_of(bytes(Bytes), Len) :-
1708 !,
1709 ( string(Bytes)
1710 -> string_length(Bytes, Len)
1711 ; length(Bytes, Len) 1712 ).
1713length_of(Len, Len).
1714
1715
1720
1721content_range(Unit, From, RangeEnd, Size) -->
1722 "Content-Range: ", atom(Unit), " ",
1723 integer(From), "-", integer(RangeEnd), "/", integer(Size),
1724 "\r\n".
1725
1726content_encoding(Encoding) -->
1727 "Content-Encoding: ", atom(Encoding), "\r\n".
1728
1729transfer_encoding(Encoding) -->
1730 "Transfer-Encoding: ", atom(Encoding), "\r\n".
1731
1732content_type(Type) -->
1733 content_type(Type, _).
1734
1735content_type(Type, Charset) -->
1736 ctype(Type),
1737 charset(Charset),
1738 "\r\n".
1739
1740ctype(Main/Sub) -->
1741 !,
1742 "Content-Type: ",
1743 atom(Main),
1744 "/",
1745 atom(Sub).
1746ctype(Type) -->
1747 !,
1748 "Content-Type: ",
1749 atom(Type).
1750
1751charset(Var) -->
1752 { var(Var) },
1753 !.
1754charset(utf8) -->
1755 !,
1756 "; charset=UTF-8".
1757charset(CharSet) -->
1758 "; charset=",
1759 atom(CharSet).
1760
1766
(Name, Value) -->
1768 { var(Name) }, 1769 !,
1770 field_name(Name),
1771 ":",
1772 whites,
1773 read_field_value(ValueChars),
1774 blanks_to_nl,
1775 !,
1776 { field_to_prolog(Name, ValueChars, Value)
1777 -> true
1778 ; atom_codes(Value, ValueChars),
1779 domain_error(Name, Value)
1780 }.
1781header_field(Name, Value) -->
1782 field_name(Name),
1783 ": ",
1784 field_value(Name, Value),
1785 "\r\n".
1786
1790
1791read_field_value([H|T]) -->
1792 [H],
1793 { \+ code_type(H, space) },
1794 !,
1795 read_field_value(T).
1796read_field_value([]) -->
1797 "".
1798read_field_value([H|T]) -->
1799 [H],
1800 read_field_value(T).
1801
1806
(Out, String) :-
1808 debug(http(send_reply), "< ~s", [String]),
1809 format(Out, '~s', [String]).
1810
(Out, String) :-
1812 debug(http(send_request), "> ~s", [String]),
1813 format(Out, '~s', [String]).
1814
1854
(Field, Value, Prolog) :-
1856 known_field(Field, _, Type),
1857 ( already_parsed(Type, Value)
1858 -> Prolog = Value
1859 ; parse_header_value_atom(Field, Value, Prolog)
1860 -> true
1861 ; to_codes(Value, Codes),
1862 parse_header_value(Field, Codes, Prolog)
1863 ).
1864
1865already_parsed(integer, V) :- !, integer(V).
1866already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
1867already_parsed(Term, V) :- subsumes_term(Term, V).
1868
1869
1874
1875known_field(content_length, true, integer).
1876known_field(status, true, integer).
1877known_field(expires, false, number).
1878known_field(cookie, true, list(_=_)).
1879known_field(set_cookie, true, list(set_cookie(_Name,_Value,_Options))).
1880known_field(host, true, _Host:_Port).
1881known_field(range, maybe, bytes(_,_)).
1882known_field(accept, maybe, list(media(_Type, _Parms, _Q, _Exts))).
1883known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
1884known_field(content_type, false, media(_Type/_Sub, _Attributes)).
1885
1886to_codes(In, Codes) :-
1887 ( is_list(In)
1888 -> Codes = In
1889 ; atom_codes(In, Codes)
1890 ).
1891
1897
1898field_to_prolog(Field, Codes, Prolog) :-
1899 known_field(Field, true, _Type),
1900 !,
1901 ( parse_header_value(Field, Codes, Prolog0)
1902 -> Prolog = Prolog0
1903 ).
1904field_to_prolog(Field, Codes, Prolog) :-
1905 known_field(Field, maybe, _Type),
1906 parse_header_value(Field, Codes, Prolog0),
1907 !,
1908 Prolog = Prolog0.
1909field_to_prolog(_, Codes, Atom) :-
1910 atom_codes(Atom, Codes).
1911
1915
(content_length, Atom, ContentLength) :-
1917 atomic(Atom),
1918 atom_number(Atom, ContentLength).
1919parse_header_value_atom(expires, Atom, Stamp) :-
1920 http_timestamp(Stamp, Atom).
1921
1926
(content_length, ValueChars, ContentLength) :-
1928 number_codes(ContentLength, ValueChars).
1929parse_header_value(expires, ValueCodes, Stamp) :-
1930 http_timestamp(Stamp, ValueCodes).
1931parse_header_value(status, ValueChars, Code) :-
1932 ( phrase(" ", L, _),
1933 append(Pre, L, ValueChars)
1934 -> number_codes(Code, Pre)
1935 ; number_codes(Code, ValueChars)
1936 ).
1937parse_header_value(cookie, ValueChars, Cookies) :-
1938 debug(cookie, 'Cookie: ~s', [ValueChars]),
1939 phrase(cookies(Cookies), ValueChars).
1940parse_header_value(set_cookie, ValueChars, SetCookie) :-
1941 debug(cookie, 'SetCookie: ~s', [ValueChars]),
1942 phrase(set_cookie(SetCookie), ValueChars).
1943parse_header_value(host, ValueChars, Host) :-
1944 ( append(HostChars, [0':|PortChars], ValueChars),
1945 catch(number_codes(Port, PortChars), _, fail)
1946 -> atom_codes(HostName, HostChars),
1947 Host = HostName:Port
1948 ; atom_codes(Host, ValueChars)
1949 ).
1950parse_header_value(range, ValueChars, Range) :-
1951 phrase(range(Range), ValueChars).
1952parse_header_value(accept, ValueChars, Media) :-
1953 parse_accept(ValueChars, Media).
1954parse_header_value(content_disposition, ValueChars, Disposition) :-
1955 phrase(content_disposition(Disposition), ValueChars).
1956parse_header_value(content_type, ValueChars, Type) :-
1957 phrase(parse_content_type(Type), ValueChars).
1958
1960
1961field_value(_, set_cookie(Name, Value, Options)) -->
1962 !,
1963 atom(Name), "=", atom(Value),
1964 value_options(Options, cookie).
1965field_value(_, disposition(Disposition, Options)) -->
1966 !,
1967 atom(Disposition), value_options(Options, disposition).
1968field_value(www_authenticate, Auth) -->
1969 auth_field_value(Auth).
1970field_value(_, Atomic) -->
1971 atom(Atomic).
1972
1976
1977auth_field_value(negotiate(Data)) -->
1978 "Negotiate ",
1979 { base64(Data, DataBase64),
1980 atom_codes(DataBase64, Codes)
1981 },
1982 string(Codes).
1983auth_field_value(negotiate) -->
1984 "Negotiate".
1985auth_field_value(basic) -->
1986 !,
1987 "Basic".
1988auth_field_value(basic(Realm)) -->
1989 "Basic Realm=\"", atom(Realm), "\"".
1990auth_field_value(digest) -->
1991 !,
1992 "Digest".
1993auth_field_value(digest(Details)) -->
1994 "Digest ", atom(Details).
1995
2002
2003value_options([], _) --> [].
2004value_options([H|T], Field) -->
2005 "; ", value_option(H, Field),
2006 value_options(T, Field).
2007
2008value_option(secure=true, cookie) -->
2009 !,
2010 "secure".
2011value_option(Name=Value, Type) -->
2012 { string_option(Name, Type) },
2013 !,
2014 atom(Name), "=",
2015 qstring(Value).
2016value_option(Name=Value, Type) -->
2017 { token_option(Name, Type) },
2018 !,
2019 atom(Name), "=", atom(Value).
2020value_option(Name=Value, _Type) -->
2021 atom(Name), "=",
2022 option_value(Value).
2023
2024string_option(filename, disposition).
2025
2026token_option(path, cookie).
2027
2028option_value(Value) -->
2029 { number(Value) },
2030 !,
2031 number(Value).
2032option_value(Value) -->
2033 { ( atom(Value)
2034 -> true
2035 ; string(Value)
2036 ),
2037 forall(string_code(_, Value, C),
2038 token_char(C))
2039 },
2040 !,
2041 atom(Value).
2042option_value(Atomic) -->
2043 qstring(Atomic).
2044
2045qstring(Atomic) -->
2046 { string_codes(Atomic, Codes) },
2047 "\"",
2048 qstring_codes(Codes),
2049 "\"".
2050
2051qstring_codes([]) --> [].
2052qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
2053
2054qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
2055qstring_code(C) --> [C].
2056
2057qstring_esc(0'").
2058qstring_esc(C) :- ctl(C).
2059
2060
2061 2064
2065:- dynamic accept_cache/2. 2066:- volatile accept_cache/2. 2067
2068parse_accept(Codes, Media) :-
2069 atom_codes(Atom, Codes),
2070 ( accept_cache(Atom, Media0)
2071 -> Media = Media0
2072 ; phrase(accept(Media0), Codes),
2073 keysort(Media0, Media1),
2074 pairs_values(Media1, Media2),
2075 assertz(accept_cache(Atom, Media2)),
2076 Media = Media2
2077 ).
2078
2082
2083accept([H|T]) -->
2084 blanks,
2085 media_range(H),
2086 blanks,
2087 ( ","
2088 -> accept(T)
2089 ; {T=[]}
2090 ).
2091
2092media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
2093 media_type(Type),
2094 blanks,
2095 ( ";"
2096 -> blanks,
2097 parameters_and_quality(TypeParams, Quality, AcceptExts)
2098 ; { TypeParams = [],
2099 Quality = 1.0,
2100 AcceptExts = []
2101 }
2102 ),
2103 { SortQuality is float(-Quality),
2104 rank_specialised(Type, TypeParams, Spec)
2105 }.
2106
2107
2111
2112content_disposition(disposition(Disposition, Options)) -->
2113 token(Disposition), blanks,
2114 value_parameters(Options).
2115
2120
2121parse_content_type(media(Type, Parameters)) -->
2122 media_type(Type), blanks,
2123 value_parameters(Parameters).
2124
2125
2133
2134rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
2135 var_or_given(Type, VT),
2136 var_or_given(SubType, VS),
2137 length(TypeParams, VP),
2138 SortVP is -VP.
2139
2140var_or_given(V, Val) :-
2141 ( var(V)
2142 -> Val = 0
2143 ; Val = -1
2144 ).
2145
2146media_type(Type/SubType) -->
2147 type(Type), "/", type(SubType).
2148
2149type(_) -->
2150 "*",
2151 !.
2152type(Type) -->
2153 token(Type).
2154
2155parameters_and_quality(Params, Quality, AcceptExts) -->
2156 token(Name),
2157 blanks, "=", blanks,
2158 ( { Name == q }
2159 -> float(Quality), blanks,
2160 value_parameters(AcceptExts),
2161 { Params = [] }
2162 ; { Params = [Name=Value|T] },
2163 parameter_value(Value),
2164 blanks,
2165 ( ";"
2166 -> blanks,
2167 parameters_and_quality(T, Quality, AcceptExts)
2168 ; { T = [],
2169 Quality = 1.0,
2170 AcceptExts = []
2171 }
2172 )
2173 ).
2174
2179
2180value_parameters([H|T]) -->
2181 ";",
2182 !,
2183 blanks, token(Name), blanks,
2184 ( "="
2185 -> blanks,
2186 ( token(Value)
2187 -> []
2188 ; quoted_string(Value)
2189 ),
2190 { H = (Name=Value) }
2191 ; { H = Name }
2192 ),
2193 blanks,
2194 value_parameters(T).
2195value_parameters([]) -->
2196 [].
2197
2198parameter_value(Value) --> token(Value), !.
2199parameter_value(Value) --> quoted_string(Value).
2200
2201
2205
2206token(Name) -->
2207 token_char(C1),
2208 token_chars(Cs),
2209 { atom_codes(Name, [C1|Cs]) }.
2210
2211token_chars([H|T]) -->
2212 token_char(H),
2213 !,
2214 token_chars(T).
2215token_chars([]) --> [].
2216
2217token_char(C) :-
2218 \+ ctl(C),
2219 \+ separator_code(C).
2220
2221ctl(C) :- between(0,31,C), !.
2222ctl(127).
2223
2224separator_code(0'().
2225separator_code(0')).
2226separator_code(0'<).
2227separator_code(0'>).
2228separator_code(0'@).
2229separator_code(0',).
2230separator_code(0';).
2231separator_code(0':).
2232separator_code(0'\\).
2233separator_code(0'").
2234separator_code(0'/).
2235separator_code(0'[).
2236separator_code(0']).
2237separator_code(0'?).
2238separator_code(0'=).
2239separator_code(0'{).
2240separator_code(0'}).
2241separator_code(0'\s).
2242separator_code(0'\t).
2243
2244term_expansion(token_char(x) --> [x], Clauses) :-
2245 findall((token_char(C)-->[C]),
2246 ( between(0, 255, C),
2247 token_char(C)
2248 ),
2249 Clauses).
2250
2251token_char(x) --> [x].
2252
2256
2257quoted_string(Text) -->
2258 "\"",
2259 quoted_text(Codes),
2260 { atom_codes(Text, Codes) }.
2261
2262quoted_text([]) -->
2263 "\"",
2264 !.
2265quoted_text([H|T]) -->
2266 "\\", !, [H],
2267 quoted_text(T).
2268quoted_text([H|T]) -->
2269 [H],
2270 !,
2271 quoted_text(T).
2272
2273
2281
([], _) --> [].
2283header_fields([content_length(CLen)|T], CLen) -->
2284 !,
2285 ( { var(CLen) }
2286 -> ""
2287 ; header_field(content_length, CLen)
2288 ),
2289 header_fields(T, CLen). 2290header_fields([status(_)|T], CLen) --> 2291 !,
2292 header_fields(T, CLen).
2293header_fields([H|T], CLen) -->
2294 { H =.. [Name, Value] },
2295 header_field(Name, Value),
2296 header_fields(T, CLen).
2297
2298
2312
2313:- public
2314 field_name//1. 2315
2316field_name(Name) -->
2317 { var(Name) },
2318 !,
2319 rd_field_chars(Chars),
2320 { atom_codes(Name, Chars) }.
2321field_name(mime_version) -->
2322 !,
2323 "MIME-Version".
2324field_name(www_authenticate) -->
2325 !,
2326 "WWW-Authenticate".
2327field_name(Name) -->
2328 { atom_codes(Name, Chars) },
2329 wr_field_chars(Chars).
2330
2331rd_field_chars_no_fold([C|T]) -->
2332 [C],
2333 { rd_field_char(C, _) },
2334 !,
2335 rd_field_chars_no_fold(T).
2336rd_field_chars_no_fold([]) -->
2337 [].
2338
2339rd_field_chars([C0|T]) -->
2340 [C],
2341 { rd_field_char(C, C0) },
2342 !,
2343 rd_field_chars(T).
2344rd_field_chars([]) -->
2345 [].
2346
2350
2351separators("()<>@,;:\\\"/[]?={} \t").
2352
2353term_expansion(rd_field_char('expand me',_), Clauses) :-
2354
2355 Clauses = [ rd_field_char(0'-, 0'_)
2356 | Cls
2357 ],
2358 separators(SepString),
2359 string_codes(SepString, Seps),
2360 findall(rd_field_char(In, Out),
2361 ( between(32, 127, In),
2362 \+ memberchk(In, Seps),
2363 In \== 0'-, 2364 code_type(Out, to_lower(In))),
2365 Cls).
2366
2367rd_field_char('expand me', _). 2368
2369wr_field_chars([C|T]) -->
2370 !,
2371 { code_type(C, to_lower(U)) },
2372 [U],
2373 wr_field_chars2(T).
2374wr_field_chars([]) -->
2375 [].
2376
2377wr_field_chars2([]) --> [].
2378wr_field_chars2([C|T]) --> 2379 ( { C == 0'_ }
2380 -> "-",
2381 wr_field_chars(T)
2382 ; [C],
2383 wr_field_chars2(T)
2384 ).
2385
2389
2390now -->
2391 { get_time(Time)
2392 },
2393 rfc_date(Time).
2394
2399
2400rfc_date(Time, String, Tail) :-
2401 stamp_date_time(Time, Date, 'UTC'),
2402 format_time(codes(String, Tail),
2403 '%a, %d %b %Y %T GMT',
2404 Date, posix).
2405
2414
2415http_timestamp(Time, Text), nonvar(Text) =>
2416 ( parse_time(Text, _Format, Time0)
2417 -> Time =:= Time0
2418 ; syntax_error(http_timestamp(Text))
2419 ).
2420http_timestamp(Time, Atom), number(Time) =>
2421 stamp_date_time(Time, Date, 'UTC'),
2422 format_time(atom(Atom),
2423 '%a, %d %b %Y %T GMT',
2424 Date, posix).
2425
2426
2427 2430
2431request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
2432 method(Method),
2433 blanks,
2434 nonblanks(Query),
2435 { atom_codes(ReqURI, Query),
2436 request_uri_parts(ReqURI, Header, Rest)
2437 },
2438 request_header(Fd, Rest),
2439 !.
2440request(Fd, [unknown(What)|Header]) -->
2441 string(What),
2442 eos,
2443 !,
2444 { http_read_header(Fd, Header)
2445 -> true
2446 ; Header = []
2447 }.
2448
2449method(get) --> "GET", !.
2450method(put) --> "PUT", !.
2451method(head) --> "HEAD", !.
2452method(post) --> "POST", !.
2453method(delete) --> "DELETE", !.
2454method(patch) --> "PATCH", !.
2455method(options) --> "OPTIONS", !.
2456method(trace) --> "TRACE", !.
2457
2469
2470request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
2471 uri_components(ReqURI, Components),
2472 uri_data(path, Components, PathText),
2473 uri_encoded(path, Path, PathText),
2474 phrase(uri_parts(Components), Parts, Rest).
2475
2476uri_parts(Components) -->
2477 uri_search(Components),
2478 uri_fragment(Components).
2479
2480uri_search(Components) -->
2481 { uri_data(search, Components, Search),
2482 nonvar(Search),
2483 catch(uri_query_components(Search, Query),
2484 error(syntax_error(_),_),
2485 fail)
2486 },
2487 !,
2488 [ search(Query) ].
2489uri_search(_) --> [].
2490
2491uri_fragment(Components) -->
2492 { uri_data(fragment, Components, String),
2493 nonvar(String),
2494 !,
2495 uri_encoded(fragment, Fragment, String)
2496 },
2497 [ fragment(Fragment) ].
2498uri_fragment(_) --> [].
2499
2504
(_, []) --> 2506 blanks,
2507 eos,
2508 !.
2509request_header(Fd, [http_version(Version)|Header]) -->
2510 http_version(Version),
2511 blanks,
2512 eos,
2513 !,
2514 { Version = 1-_
2515 -> http_read_header(Fd, Header)
2516 ; Header = []
2517 }.
2518
2519http_version(Version) -->
2520 blanks,
2521 "HTTP/",
2522 http_version_number(Version).
2523
2524http_version_number(Major-Minor) -->
2525 integer(Major),
2526 ".",
2527 integer(Minor).
2528
2529
2530 2533
2537
2538cookies([Name=Value|T]) -->
2539 blanks,
2540 cookie(Name, Value),
2541 !,
2542 blanks,
2543 ( ";"
2544 -> cookies(T)
2545 ; { T = [] }
2546 ).
2547cookies(List) -->
2548 string(Skipped),
2549 ";",
2550 !,
2551 { print_message(warning, http(skipped_cookie(Skipped))) },
2552 cookies(List).
2553cookies([]) -->
2554 blanks.
2555
2556cookie(Name, Value) -->
2557 cookie_name(Name),
2558 blanks, "=", blanks,
2559 cookie_value(Value).
2560
2561cookie_name(Name) -->
2562 { var(Name) },
2563 !,
2564 rd_field_chars_no_fold(Chars),
2565 { atom_codes(Name, Chars) }.
2566
2567cookie_value(Value) -->
2568 quoted_string(Value),
2569 !.
2570cookie_value(Value) -->
2571 chars_to_semicolon_or_blank(Chars),
2572 { atom_codes(Value, Chars)
2573 }.
2574
2575chars_to_semicolon_or_blank([]), ";" -->
2576 ";",
2577 !.
2578chars_to_semicolon_or_blank([]) -->
2579 " ",
2580 blanks,
2581 eos,
2582 !.
2583chars_to_semicolon_or_blank([H|T]) -->
2584 [H],
2585 !,
2586 chars_to_semicolon_or_blank(T).
2587chars_to_semicolon_or_blank([]) -->
2588 [].
2589
2590set_cookie(set_cookie(Name, Value, Options)) -->
2591 ws,
2592 cookie(Name, Value),
2593 cookie_options(Options).
2594
2595cookie_options([H|T]) -->
2596 ws,
2597 ";",
2598 ws,
2599 cookie_option(H),
2600 !,
2601 cookie_options(T).
2602cookie_options([]) -->
2603 ws.
2604
2605ws --> " ", !, ws.
2606ws --> [].
2607
2608
2617
2618cookie_option(Name=Value) -->
2619 rd_field_chars(NameChars), ws,
2620 { atom_codes(Name, NameChars) },
2621 ( "="
2622 -> ws,
2623 chars_to_semicolon(ValueChars),
2624 { atom_codes(Value, ValueChars)
2625 }
2626 ; { Value = true }
2627 ).
2628
2629chars_to_semicolon([H|T]) -->
2630 [H],
2631 { H \== 32, H \== 0'; },
2632 !,
2633 chars_to_semicolon(T).
2634chars_to_semicolon([]), ";" -->
2635 ws, ";",
2636 !.
2637chars_to_semicolon([H|T]) -->
2638 [H],
2639 chars_to_semicolon(T).
2640chars_to_semicolon([]) -->
2641 [].
2642
2650
2651range(bytes(From, To)) -->
2652 "bytes", whites, "=", whites, integer(From), "-",
2653 ( integer(To)
2654 -> ""
2655 ; { To = end }
2656 ).
2657
2658
2659 2662
2677
2678reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
2679 http_version(HttpVersion),
2680 blanks,
2681 ( status_number(Status, Code)
2682 -> []
2683 ; integer(Status)
2684 ),
2685 blanks,
2686 string(CommentCodes),
2687 blanks_to_nl,
2688 !,
2689 blanks,
2690 { atom_codes(Comment, CommentCodes),
2691 http_read_header(Fd, Header)
2692 }.
2693
2694
2695 2698
2704
(Fd, Header) :-
2706 read_header_data(Fd, Text),
2707 http_parse_header(Text, Header).
2708
(Fd, Header) :-
2710 read_line_to_codes(Fd, Header, Tail),
2711 read_header_data(Header, Fd, Tail),
2712 debug(http(header), 'Header = ~n~s~n', [Header]).
2713
([0'\r,0'\n], _, _) :- !.
2715read_header_data([0'\n], _, _) :- !.
2716read_header_data([], _, _) :- !.
2717read_header_data(_, Fd, Tail) :-
2718 read_line_to_codes(Fd, Tail, NewTail),
2719 read_header_data(Tail, Fd, NewTail).
2720
2727
(Text, Header) :-
2729 phrase(header(Header), Text),
2730 debug(http(header), 'Field: ~p', [Header]).
2731
(List) -->
2733 header_field(Name, Value),
2734 !,
2735 { mkfield(Name, Value, List, Tail)
2736 },
2737 blanks,
2738 header(Tail).
2739header([]) -->
2740 blanks,
2741 eos,
2742 !.
2743header(_) -->
2744 string(S), blanks_to_nl,
2745 !,
2746 { string_codes(Line, S),
2747 syntax_error(http_parameter(Line))
2748 }.
2749
2761
2762:- multifile
2763 http:http_address//0. 2764
2765address -->
2766 http:http_address,
2767 !.
2768address -->
2769 { gethostname(Host) },
2770 html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
2771 ' httpd at ', Host
2772 ])).
2773
2774mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
2775mkfield(Name, Value, [Att|Tail], Tail) :-
2776 Att =.. [Name, Value].
2777
2783
2813
2814
2815 2818
2819:- multifile
2820 prolog:message//1,
2821 prolog:error_message//1. 2822
2823prolog:error_message(http_write_short(Data, Sent)) -->
2824 data(Data),
2825 [ ': remote hangup after ~D bytes'-[Sent] ].
2826prolog:error_message(syntax_error(http_request(Request))) -->
2827 [ 'Illegal HTTP request: ~s'-[Request] ].
2828prolog:error_message(syntax_error(http_parameter(Line))) -->
2829 [ 'Illegal HTTP parameter: ~s'-[Line] ].
2830
2831prolog:message(http(skipped_cookie(S))) -->
2832 [ 'Skipped illegal cookie: ~s'-[S] ].
2833
2834data(bytes(MimeType, _Bytes)) -->
2835 !,
2836 [ 'bytes(~p, ...)'-[MimeType] ].
2837data(Data) -->
2838 [ '~p'-[Data] ]