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 with_encoding(+, +, 0). 270
277
278http_reply_data(Data, Out, HdrExtra, Method, Code) :-
279 http_reply_data_(Data, Out, HdrExtra, Method, Code),
280 flush_output(Out).
281
282http_reply_data_(html(HTML), Out, HdrExtra, Method, Code) :-
283 !,
284 phrase(reply_header(html(HTML), HdrExtra, Code), Header),
285 send_reply_header(Out, Header),
286 if_no_head(with_encoding(Out, utf8, print_html(Out, HTML)), Method).
287http_reply_data_(file(Type, File), Out, HdrExtra, Method, Code) :-
288 !,
289 phrase(reply_header(file(Type, File), HdrExtra, Code), Header),
290 reply_file(Out, File, Header, Method).
291http_reply_data_(gzip_file(Type, File), Out, HdrExtra, Method, Code) :-
292 !,
293 phrase(reply_header(gzip_file(Type, File), HdrExtra, Code), Header),
294 reply_file(Out, File, Header, Method).
295http_reply_data_(file(Type, File, Range), Out, HdrExtra, Method, Code) :-
296 !,
297 phrase(reply_header(file(Type, File, Range), HdrExtra, Code), Header),
298 reply_file_range(Out, File, Header, Range, Method).
299http_reply_data_(tmp_file(Type, File), Out, HdrExtra, Method, Code) :-
300 !,
301 phrase(reply_header(tmp_file(Type, File), HdrExtra, Code), Header),
302 reply_file(Out, File, Header, Method).
303http_reply_data_(bytes(Type, Bytes), Out, HdrExtra, Method, Code) :-
304 !,
305 phrase(reply_header(bytes(Type, Bytes), HdrExtra, Code), Header),
306 send_reply_header(Out, Header),
307 if_no_head(format(Out, '~s', [Bytes]), Method).
308http_reply_data_(stream(In, Len), Out, HdrExtra, Method, Code) :-
309 !,
310 phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header),
311 copy_stream(Out, In, Header, Method, 0, end).
312http_reply_data_(cgi_stream(In, Len), Out, HdrExtra, Method, Code) :-
313 !,
314 http_read_header(In, CgiHeader),
315 seek(In, 0, current, Pos),
316 Size is Len - Pos,
317 http_join_headers(HdrExtra, CgiHeader, Hdr2),
318 phrase(reply_header(cgi_data(Size), Hdr2, Code), Header),
319 copy_stream(Out, In, Header, Method, 0, end).
320
321if_no_head(_, head) :-
322 !.
323if_no_head(Goal, _) :-
324 call(Goal).
325
326with_encoding(Out, Encoding, Goal) :-
327 stream_property(Out, encoding(Old)),
328 ( Old == Encoding
329 -> call(Goal)
330 ; setup_call_cleanup(
331 set_stream(Out, encoding(Encoding)),
332 call(Goal),
333 set_stream(Out, encoding(Old)))
334 ).
335
336reply_file(Out, _File, Header, head) :-
337 !,
338 send_reply_header(Out, Header).
339reply_file(Out, File, Header, _) :-
340 setup_call_cleanup(
341 open(File, read, In, [type(binary)]),
342 copy_stream(Out, In, Header, 0, end),
343 close(In)).
344
345reply_file_range(Out, _File, Header, _Range, head) :-
346 !,
347 send_reply_header(Out, Header).
348reply_file_range(Out, File, Header, bytes(From, To), _) :-
349 setup_call_cleanup(
350 open(File, read, In, [type(binary)]),
351 copy_stream(Out, In, Header, From, To),
352 close(In)).
353
354copy_stream(Out, _, Header, head, _, _) :-
355 !,
356 send_reply_header(Out, Header).
357copy_stream(Out, In, Header, _, From, To) :-
358 copy_stream(Out, In, Header, From, To).
359
360copy_stream(Out, In, Header, From, To) :-
361 ( From == 0
362 -> true
363 ; seek(In, From, bof, _)
364 ),
365 peek_byte(In, _),
366 send_reply_header(Out, Header),
367 ( To == end
368 -> copy_stream_data(In, Out)
369 ; Len is To - From,
370 copy_stream_data(In, Out, Len)
371 ).
372
373
404
405http_status_reply(Status, Out, Options) :-
406 _{header:HdrExtra, context:Context, code:Code, method:Method} :< Options,
407 http_status_reply(Status, Out, HdrExtra, Context, [method(Method)], Code).
408
409http_status_reply(Status, Out, HdrExtra, Code) :-
410 http_status_reply(Status, Out, HdrExtra, [], Code).
411
412http_status_reply(Status, Out, HdrExtra, Context, Code) :-
413 http_status_reply(Status, Out, HdrExtra, Context, [method(get)], Code).
414
415http_status_reply(Status, Out, HdrExtra, Context, Request, Code) :-
416 option(method(Method), Request, get),
417 parsed_accept(Request, Accept),
418 status_reply_flush(Status, Out,
419 _{ context: Context,
420 method: Method,
421 code: Code,
422 accept: Accept,
423 header: HdrExtra
424 }).
425
426parsed_accept(Request, Accept) :-
427 memberchk(accept(Accept0), Request),
428 http_parse_header_value(accept, Accept0, Accept1),
429 !,
430 Accept = Accept1.
431parsed_accept(_, [ media(text/html, [], 0.1, []),
432 media(_, [], 0.01, [])
433 ]).
434
435status_reply_flush(Status, Out, Options) :-
436 status_reply(Status, Out, Options),
437 !,
438 flush_output(Out).
439
450
452status_reply(no_content, Out, Options) :-
453 !,
454 phrase(reply_header(status(no_content), Options), Header),
455 send_reply_header(Out, Header).
456status_reply(switching_protocols(_Goal,SwitchOptions), Out, Options) :-
457 !,
458 ( option(headers(Extra1), SwitchOptions)
459 -> true
460 ; option(header(Extra1), SwitchOptions, [])
461 ),
462 http_join_headers(Options.header, Extra1, HdrExtra),
463 phrase(reply_header(status(switching_protocols),
464 Options.put(header,HdrExtra)), Header),
465 send_reply_header(Out, Header).
466status_reply(authorise(basic, ''), Out, Options) :-
467 !,
468 status_reply(authorise(basic), Out, Options).
469status_reply(authorise(basic, Realm), Out, Options) :-
470 !,
471 status_reply(authorise(basic(Realm)), Out, Options).
472status_reply(not_modified, Out, Options) :-
473 !,
474 phrase(reply_header(status(not_modified), Options), Header),
475 send_reply_header(Out, Header).
477status_reply(busy, Out, Options) :-
478 status_reply(service_unavailable(busy), Out, Options).
479status_reply(unavailable(Why), Out, Options) :-
480 status_reply(service_unavailable(Why), Out, Options).
481status_reply(resource_error(Why), Out, Options) :-
482 status_reply(service_unavailable(Why), Out, Options).
484status_reply(Status, Out, Options) :-
485 status_has_content(Status),
486 status_page_hook(Status, Reply, Options),
487 serialize_body(Reply, Body),
488 Status =.. List,
489 append(List, [Body], ExList),
490 ExStatus =.. ExList,
491 phrase(reply_header(ExStatus, Options), Header),
492 send_reply_header(Out, Header),
493 reply_status_body(Out, Body, Options).
494
499
500status_has_content(created(_Location)).
501status_has_content(moved(_To)).
502status_has_content(moved_temporary(_To)).
503status_has_content(gone(_URL)).
504status_has_content(see_other(_To)).
505status_has_content(bad_request(_ErrorTerm)).
506status_has_content(authorise(_Method)).
507status_has_content(forbidden(_URL)).
508status_has_content(not_found(_URL)).
509status_has_content(method_not_allowed(_Method, _URL)).
510status_has_content(not_acceptable(_Why)).
511status_has_content(server_error(_ErrorTerm)).
512status_has_content(service_unavailable(_Why)).
513
522
523serialize_body(Reply, Body) :-
524 http:serialize_reply(Reply, Body),
525 !.
526serialize_body(html_tokens(Tokens), body(text/html, utf8, Content)) :-
527 !,
528 with_output_to(string(Content), print_html(Tokens)).
529serialize_body(Reply, Reply) :-
530 Reply = body(_,_,_),
531 !.
532serialize_body(Reply, _) :-
533 domain_error(http_reply_body, Reply).
534
535reply_status_body(_, _, Options) :-
536 Options.method == head,
537 !.
538reply_status_body(Out, body(_Type, Encoding, Content), _Options) :-
539 ( Encoding == octet
540 -> format(Out, '~s', [Content])
541 ; setup_call_cleanup(
542 set_stream(Out, encoding(Encoding)),
543 format(Out, '~s', [Content]),
544 set_stream(Out, encoding(octet)))
545 ).
546
556
571
572status_page_hook(Term, Reply, Options) :-
573 Context = Options.context,
574 functor(Term, Name, _),
575 status_number_fact(Name, Code),
576 ( Options.code = Code,
577 http:status_reply(Term, Reply, Options)
578 ; http:status_page(Term, Context, HTML),
579 Reply = html_tokens(HTML)
580 ; http:status_page(Code, Context, HTML), 581 Reply = html_tokens(HTML)
582 ),
583 !.
584status_page_hook(created(Location), html_tokens(HTML), _Options) :-
585 phrase(page([ title('201 Created')
586 ],
587 [ h1('Created'),
588 p(['The document was created ',
589 a(href(Location), ' Here')
590 ]),
591 \address
592 ]),
593 HTML).
594status_page_hook(moved(To), html_tokens(HTML), _Options) :-
595 phrase(page([ title('301 Moved Permanently')
596 ],
597 [ h1('Moved Permanently'),
598 p(['The document has moved ',
599 a(href(To), ' Here')
600 ]),
601 \address
602 ]),
603 HTML).
604status_page_hook(moved_temporary(To), html_tokens(HTML), _Options) :-
605 phrase(page([ title('302 Moved Temporary')
606 ],
607 [ h1('Moved Temporary'),
608 p(['The document is currently ',
609 a(href(To), ' Here')
610 ]),
611 \address
612 ]),
613 HTML).
614status_page_hook(gone(URL), html_tokens(HTML), _Options) :-
615 phrase(page([ title('410 Resource Gone')
616 ],
617 [ h1('Resource Gone'),
618 p(['The document has been removed ',
619 a(href(URL), ' from here')
620 ]),
621 \address
622 ]),
623 HTML).
624status_page_hook(see_other(To), html_tokens(HTML), _Options) :-
625 phrase(page([ title('303 See Other')
626 ],
627 [ h1('See Other'),
628 p(['See other document ',
629 a(href(To), ' Here')
630 ]),
631 \address
632 ]),
633 HTML).
634status_page_hook(bad_request(ErrorTerm), html_tokens(HTML), _Options) :-
635 '$messages':translate_message(ErrorTerm, Lines, []),
636 phrase(page([ title('400 Bad Request')
637 ],
638 [ h1('Bad Request'),
639 p(\html_message_lines(Lines)),
640 \address
641 ]),
642 HTML).
643status_page_hook(authorise(_Method), html_tokens(HTML), _Options):-
644 phrase(page([ title('401 Authorization Required')
645 ],
646 [ h1('Authorization Required'),
647 p(['This server could not verify that you ',
648 'are authorized to access the document ',
649 'requested. Either you supplied the wrong ',
650 'credentials (e.g., bad password), or your ',
651 'browser doesn\'t understand how to supply ',
652 'the credentials required.'
653 ]),
654 \address
655 ]),
656 HTML).
657status_page_hook(forbidden(URL), html_tokens(HTML), _Options) :-
658 phrase(page([ title('403 Forbidden')
659 ],
660 [ h1('Forbidden'),
661 p(['You don\'t have permission to access ', URL,
662 ' on this server'
663 ]),
664 \address
665 ]),
666 HTML).
667status_page_hook(not_found(URL), html_tokens(HTML), _Options) :-
668 phrase(page([ title('404 Not Found')
669 ],
670 [ h1('Not Found'),
671 p(['The requested URL ', tt(URL),
672 ' was not found on this server'
673 ]),
674 \address
675 ]),
676 HTML).
677status_page_hook(method_not_allowed(Method,URL), html_tokens(HTML), _Options) :-
678 upcase_atom(Method, UMethod),
679 phrase(page([ title('405 Method not allowed')
680 ],
681 [ h1('Method not allowed'),
682 p(['The requested URL ', tt(URL),
683 ' does not support method ', tt(UMethod), '.'
684 ]),
685 \address
686 ]),
687 HTML).
688status_page_hook(not_acceptable(WhyHTML), html_tokens(HTML), _Options) :-
689 phrase(page([ title('406 Not Acceptable')
690 ],
691 [ h1('Not Acceptable'),
692 WhyHTML,
693 \address
694 ]),
695 HTML).
696status_page_hook(server_error(ErrorTerm), html_tokens(HTML), _Options) :-
697 '$messages':translate_message(ErrorTerm, Lines, []),
698 phrase(page([ title('500 Internal server error')
699 ],
700 [ h1('Internal server error'),
701 p(\html_message_lines(Lines)),
702 \address
703 ]),
704 HTML).
705status_page_hook(service_unavailable(Why), html_tokens(HTML), _Options) :-
706 phrase(page([ title('503 Service Unavailable')
707 ],
708 [ h1('Service Unavailable'),
709 \unavailable(Why),
710 \address
711 ]),
712 HTML).
713
714unavailable(busy) -->
715 html(p(['The server is temporarily out of resources, ',
716 'please try again later'])).
717unavailable(error(Formal,Context)) -->
718 { '$messages':translate_message(error(Formal,Context), Lines, []) },
719 html_message_lines(Lines).
720unavailable(HTML) -->
721 html(HTML).
722
723html_message_lines([]) -->
724 [].
725html_message_lines([nl|T]) -->
726 !,
727 html([br([])]),
728 html_message_lines(T).
729html_message_lines([flush]) -->
730 [].
731html_message_lines([ansi(_Style,Fmt,Args)|T]) -->
732 !,
733 { format(string(S), Fmt, Args)
734 },
735 html([S]),
736 html_message_lines(T).
737html_message_lines([url(Pos)|T]) -->
738 !,
739 msg_url(Pos),
740 html_message_lines(T).
741html_message_lines([url(URL, Label)|T]) -->
742 !,
743 { msg_label(Label, Text) },
744 ( { atomic(URL) }
745 -> html(a(href(URL), Text))
746 ; html([Text]) 747 ),
748 html_message_lines(T).
749html_message_lines([Fmt-Args|T]) -->
750 !,
751 { format(string(S), Fmt, Args)
752 },
753 html([S]),
754 html_message_lines(T).
755html_message_lines([Fmt|T]) -->
756 !,
757 { format(string(S), Fmt, [])
758 },
759 html([S]),
760 html_message_lines(T).
761
766
767msg_label(ansi(_Style, Fmt, Args), Text) :-
768 !,
769 format(string(Text), Fmt, Args).
770msg_label(ansi(_Style, Fmt, Args, _Ctx), Text) :-
771 !,
772 format(string(Text), Fmt, Args).
773msg_label(Fmt-Args, Text) :-
774 !,
775 format(string(Text), Fmt, Args).
776msg_label(Text, Text).
777
778msg_url(File:Line:Pos) -->
779 !,
780 html([File, :, Line, :, Pos]).
781msg_url(File:Line) -->
782 !,
783 html([File, :, Line]).
784msg_url(File) -->
785 html([File]).
786
791
([], H, H).
793http_join_headers([H|T], Hdr0, Hdr) :-
794 functor(H, N, A),
795 functor(H2, N, A),
796 member(H2, Hdr0),
797 !,
798 http_join_headers(T, Hdr0, Hdr).
799http_join_headers([H|T], Hdr0, [H|Hdr]) :-
800 http_join_headers(T, Hdr0, Hdr).
801
802
811
812http_update_encoding(Header0, Encoding, Header) :-
813 memberchk(content_type(Type), Header0),
814 !,
815 http_update_encoding(Type, Header0, Encoding, Header).
816http_update_encoding(Header, octet, Header).
817
818http_update_encoding('text/event-stream', Header, utf8, Header) :-
819 !.
820http_update_encoding(Type0, Header0, utf8, [content_type(Type)|Header]) :-
821 sub_atom(Type0, 0, _, _, 'text/'),
822 !,
823 select(content_type(_), Header0, Header),
824 !,
825 ( sub_atom(Type0, S, _, _, ';')
826 -> sub_atom(Type0, 0, S, _, B)
827 ; B = Type0
828 ),
829 atom_concat(B, '; charset=UTF-8', Type).
830http_update_encoding(Type, Header, Encoding, Header) :-
831 ( sub_atom_icasechk(Type, _, 'utf-8')
832 -> Encoding = utf8
833 ; http:mime_type_encoding(Type, Encoding)
834 -> true
835 ; mime_type_encoding(Type, Encoding)
836 -> true
837 ; Encoding = octet
838 ).
839
844
845mime_type_encoding('application/json', utf8).
846mime_type_encoding('application/jsonrequest', utf8).
847mime_type_encoding('application/x-prolog', utf8).
848mime_type_encoding('application/n-quads', utf8).
849mime_type_encoding('application/n-triples', utf8).
850mime_type_encoding('application/sparql-query', utf8).
851mime_type_encoding('application/trig', utf8).
852mime_type_encoding('application/sparql-results+json', utf8).
853mime_type_encoding('application/sparql-results+xml', utf8).
854
862
863
868
869http_update_connection(CgiHeader, Request, Connect,
870 [connection(Connect)|Rest]) :-
871 select(connection(CgiConn), CgiHeader, Rest),
872 !,
873 connection(Request, ReqConnection),
874 join_connection(ReqConnection, CgiConn, Connect).
875http_update_connection(CgiHeader, Request, Connect,
876 [connection(Connect)|CgiHeader]) :-
877 connection(Request, Connect).
878
879join_connection(Keep1, Keep2, Connection) :-
880 ( downcase_atom(Keep1, 'keep-alive'),
881 downcase_atom(Keep2, 'keep-alive')
882 -> Connection = 'Keep-Alive'
883 ; Connection = close
884 ).
885
886
890
891connection(Header, Close) :-
892 ( memberchk(connection(Connection), Header)
893 -> Close = Connection
894 ; memberchk(http_version(1-X), Header),
895 X >= 1
896 -> Close = 'Keep-Alive'
897 ; Close = close
898 ).
899
900
916
917http_update_transfer(Request, CgiHeader, Transfer, Header) :-
918 setting(http:chunked_transfer, When),
919 http_update_transfer(When, Request, CgiHeader, Transfer, Header).
920
921http_update_transfer(never, _, CgiHeader, none, Header) :-
922 !,
923 delete(CgiHeader, transfer_encoding(_), Header).
924http_update_transfer(_, _, CgiHeader, none, Header) :-
925 memberchk(location(_), CgiHeader),
926 !,
927 delete(CgiHeader, transfer_encoding(_), Header).
928http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
929 select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
930 !,
931 transfer(Request, ReqConnection),
932 join_transfer(ReqConnection, CgiTransfer, Transfer),
933 ( Transfer == none
934 -> Header = Rest
935 ; Header = [transfer_encoding(Transfer)|Rest]
936 ).
937http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
938 transfer(Request, Transfer),
939 Transfer \== none,
940 !,
941 Header = [transfer_encoding(Transfer)|CgiHeader].
942http_update_transfer(_, _, CgiHeader, event_stream, CgiHeader) :-
943 memberchk(content_type('text/event-stream'), CgiHeader),
944 !.
945http_update_transfer(_, _, CgiHeader, none, CgiHeader).
946
947join_transfer(chunked, chunked, chunked) :- !.
948join_transfer(_, _, none).
949
950
954
955transfer(Header, Transfer) :-
956 ( memberchk(transfer_encoding(Transfer0), Header)
957 -> Transfer = Transfer0
958 ; memberchk(http_version(1-X), Header),
959 X >= 1
960 -> Transfer = chunked
961 ; Transfer = none
962 ).
963
964
970
971content_length_in_encoding(Enc, Stream, Bytes) :-
972 stream_property(Stream, position(Here)),
973 setup_call_cleanup(
974 open_null_stream(Out),
975 ( set_stream(Out, encoding(Enc)),
976 catch(copy_stream_data(Stream, Out), _, fail),
977 flush_output(Out),
978 byte_count(Out, Bytes)
979 ),
980 ( close(Out, [force(true)]),
981 set_stream_position(Stream, Here)
982 )).
983
984
985 988
1094
1095http_post_data(Data, Out, HdrExtra),
1096 http:post_data_hook(Data, Out, HdrExtra) =>
1097 true.
1098http_post_data(html(HTML), Out, HdrExtra) =>
1099 phrase(post_header(html(HTML), HdrExtra), Header),
1100 send_request_header(Out, Header),
1101 print_html(Out, HTML).
1102http_post_data(xml(XML), Out, HdrExtra) =>
1103 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
1104http_post_data(xml(Type, XML), Out, HdrExtra) =>
1105 http_post_data(xml(Type, XML, []), Out, HdrExtra).
1106http_post_data(xml(Type, XML, Options), Out, HdrExtra) =>
1107 setup_call_cleanup(
1108 new_memory_file(MemFile),
1109 ( setup_call_cleanup(
1110 open_memory_file(MemFile, write, MemOut),
1111 xml_write(MemOut, XML, Options),
1112 close(MemOut)),
1113 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
1114 ),
1115 free_memory_file(MemFile)).
1116http_post_data(file(File), Out, HdrExtra) =>
1117 ( file_mime_type(File, Type)
1118 -> true
1119 ; Type = text/plain
1120 ),
1121 http_post_data(file(Type, File), Out, HdrExtra).
1122http_post_data(file(Type, File), Out, HdrExtra) =>
1123 phrase(post_header(file(Type, File), HdrExtra), Header),
1124 send_request_header(Out, Header),
1125 setup_call_cleanup(
1126 open(File, read, In, [type(binary)]),
1127 copy_stream_data(In, Out),
1128 close(In)).
1129http_post_data(memory_file(Type, Handle), Out, HdrExtra) =>
1130 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1131 send_request_header(Out, Header),
1132 setup_call_cleanup(
1133 open_memory_file(Handle, read, In, [encoding(octet)]),
1134 copy_stream_data(In, Out),
1135 close(In)).
1136http_post_data(codes(Codes), Out, HdrExtra) =>
1137 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1138http_post_data(codes(Type, Codes), Out, HdrExtra) =>
1139 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1140 send_request_header(Out, Header),
1141 setup_call_cleanup(
1142 set_stream(Out, encoding(utf8)),
1143 format(Out, '~s', [Codes]),
1144 set_stream(Out, encoding(octet))).
1145http_post_data(bytes(Type, Bytes), Out, HdrExtra) =>
1146 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1147 send_request_header(Out, Header),
1148 format(Out, '~s', [Bytes]).
1149http_post_data(atom(Atom), Out, HdrExtra) =>
1150 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1151http_post_data(atom(Type, Atom), Out, HdrExtra) =>
1152 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1153 send_request_header(Out, Header),
1154 setup_call_cleanup(
1155 set_stream(Out, encoding(utf8)),
1156 write(Out, Atom),
1157 set_stream(Out, encoding(octet))).
1158http_post_data(string(String), Out, HdrExtra) =>
1159 http_post_data(atom(text/plain, String), Out, HdrExtra).
1160http_post_data(string(Type, String), Out, HdrExtra) =>
1161 phrase(post_header(string(Type, String), HdrExtra), Header),
1162 send_request_header(Out, Header),
1163 setup_call_cleanup(
1164 set_stream(Out, encoding(utf8)),
1165 write(Out, String),
1166 set_stream(Out, encoding(octet))).
1167http_post_data(cgi_stream(In, _Len), Out, HdrExtra) =>
1168 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1169 http_post_data(cgi_stream(In), Out, HdrExtra).
1170http_post_data(cgi_stream(In), Out, HdrExtra) =>
1171 http_read_header(In, Header0),
1172 http_update_encoding(Header0, Encoding, Header),
1173 content_length_in_encoding(Encoding, In, Size),
1174 http_join_headers(HdrExtra, Header, Hdr2),
1175 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1176 send_request_header(Out, HeaderText),
1177 setup_call_cleanup(
1178 set_stream(Out, encoding(Encoding)),
1179 copy_stream_data(In, Out),
1180 set_stream(Out, encoding(octet))).
1181http_post_data(form(Fields), Out, HdrExtra) =>
1182 parse_url_search(Codes, Fields),
1183 length(Codes, Size),
1184 http_join_headers(HdrExtra,
1185 [ content_type('application/x-www-form-urlencoded')
1186 ], Header),
1187 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1188 send_request_header(Out, HeaderChars),
1189 format(Out, '~s', [Codes]).
1190http_post_data(form_data(Data), Out, HdrExtra) =>
1191 setup_call_cleanup(
1192 new_memory_file(MemFile),
1193 ( setup_call_cleanup(
1194 open_memory_file(MemFile, write, MimeOut),
1195 mime_pack(Data, MimeOut, Boundary),
1196 close(MimeOut)),
1197 size_memory_file(MemFile, Size, octet),
1198 format(string(ContentType),
1199 'multipart/form-data; boundary=~w', [Boundary]),
1200 http_join_headers(HdrExtra,
1201 [ mime_version('1.0'),
1202 content_type(ContentType)
1203 ], Header),
1204 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1205 send_request_header(Out, HeaderChars),
1206 setup_call_cleanup(
1207 open_memory_file(MemFile, read, In, [encoding(octet)]),
1208 copy_stream_data(In, Out),
1209 close(In))
1210 ),
1211 free_memory_file(MemFile)).
1212http_post_data(List, Out, HdrExtra), is_list(List) => 1213 setup_call_cleanup(
1214 new_memory_file(MemFile),
1215 ( setup_call_cleanup(
1216 open_memory_file(MemFile, write, MimeOut),
1217 mime_pack(List, MimeOut, Boundary),
1218 close(MimeOut)),
1219 size_memory_file(MemFile, Size, octet),
1220 format(string(ContentType),
1221 'multipart/mixed; boundary=~w', [Boundary]),
1222 http_join_headers(HdrExtra,
1223 [ mime_version('1.0'),
1224 content_type(ContentType)
1225 ], Header),
1226 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1227 send_request_header(Out, HeaderChars),
1228 setup_call_cleanup(
1229 open_memory_file(MemFile, read, In, [encoding(octet)]),
1230 copy_stream_data(In, Out),
1231 close(In))
1232 ),
1233 free_memory_file(MemFile)).
1234
1239
(html(Tokens), HdrExtra) -->
1241 header_fields(HdrExtra, Len),
1242 content_length(html(Tokens), Len),
1243 content_type(text/html),
1244 "\r\n".
1245post_header(file(Type, File), HdrExtra) -->
1246 header_fields(HdrExtra, Len),
1247 content_length(file(File), Len),
1248 content_type(Type),
1249 "\r\n".
1250post_header(memory_file(Type, File), HdrExtra) -->
1251 header_fields(HdrExtra, Len),
1252 content_length(memory_file(File), Len),
1253 content_type(Type),
1254 "\r\n".
1255post_header(cgi_data(Size), HdrExtra) -->
1256 header_fields(HdrExtra, Len),
1257 content_length(Size, Len),
1258 "\r\n".
1259post_header(codes(Type, Codes), HdrExtra) -->
1260 header_fields(HdrExtra, Len),
1261 content_length(codes(Codes, utf8), Len),
1262 content_type(Type, utf8),
1263 "\r\n".
1264post_header(bytes(Type, Bytes), HdrExtra) -->
1265 header_fields(HdrExtra, Len),
1266 content_length(bytes(Bytes), Len),
1267 content_type(Type),
1268 "\r\n".
1269post_header(atom(Type, Atom), HdrExtra) -->
1270 header_fields(HdrExtra, Len),
1271 content_length(atom(Atom, utf8), Len),
1272 content_type(Type, utf8),
1273 "\r\n".
1274post_header(string(Type, String), HdrExtra) -->
1275 header_fields(HdrExtra, Len),
1276 content_length(string(String, utf8), Len),
1277 content_type(Type, utf8),
1278 "\r\n".
1279
1280
1281 1284
1289
(Out, What, HdrExtra) :-
1291 phrase(reply_header(What, HdrExtra, _Code), String),
1292 !,
1293 send_reply_header(Out, String).
1294
1316
(Data, Dict) -->
1318 { _{header:HdrExtra, code:Code} :< Dict },
1319 reply_header(Data, HdrExtra, Code).
1320
(string(String), HdrExtra, Code) -->
1322 reply_header(string(text/plain, String), HdrExtra, Code).
1323reply_header(string(Type, String), HdrExtra, Code) -->
1324 vstatus(ok, Code, HdrExtra),
1325 date(now),
1326 header_fields(HdrExtra, CLen),
1327 content_length(codes(String, utf8), CLen),
1328 content_type(Type, utf8),
1329 "\r\n".
1330reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
1331 vstatus(ok, Code, HdrExtra),
1332 date(now),
1333 header_fields(HdrExtra, CLen),
1334 content_length(bytes(Bytes), CLen),
1335 content_type(Type),
1336 "\r\n".
1337reply_header(html(Tokens), HdrExtra, Code) -->
1338 vstatus(ok, Code, HdrExtra),
1339 date(now),
1340 header_fields(HdrExtra, CLen),
1341 content_length(html(Tokens, utf8), CLen),
1342 content_type(text/html, utf8),
1343 "\r\n".
1344reply_header(file(Type, File), HdrExtra, Code) -->
1345 vstatus(ok, Code, HdrExtra),
1346 date(now),
1347 modified(file(File)),
1348 header_fields(HdrExtra, CLen),
1349 content_length(file(File), CLen),
1350 content_type(Type),
1351 "\r\n".
1352reply_header(gzip_file(Type, File), HdrExtra, Code) -->
1353 vstatus(ok, Code, HdrExtra),
1354 date(now),
1355 modified(file(File)),
1356 header_fields(HdrExtra, CLen),
1357 content_length(file(File), CLen),
1358 content_type(Type),
1359 content_encoding(gzip),
1360 "\r\n".
1361reply_header(file(Type, File, Range), HdrExtra, Code) -->
1362 vstatus(partial_content, Code, HdrExtra),
1363 date(now),
1364 modified(file(File)),
1365 header_fields(HdrExtra, CLen),
1366 content_length(file(File, Range), CLen),
1367 content_type(Type),
1368 "\r\n".
1369reply_header(tmp_file(Type, File), HdrExtra, Code) -->
1370 vstatus(ok, Code, HdrExtra),
1371 date(now),
1372 header_fields(HdrExtra, CLen),
1373 content_length(file(File), CLen),
1374 content_type(Type),
1375 "\r\n".
1376reply_header(cgi_data(Size), HdrExtra, Code) -->
1377 vstatus(ok, Code, HdrExtra),
1378 date(now),
1379 header_fields(HdrExtra, CLen),
1380 content_length(Size, CLen),
1381 "\r\n".
1382reply_header(event_stream, HdrExtra, Code) -->
1383 vstatus(ok, Code, HdrExtra),
1384 date(now),
1385 header_fields(HdrExtra, _),
1386 "\r\n".
1387reply_header(chunked_data, HdrExtra, Code) -->
1388 vstatus(ok, Code, HdrExtra),
1389 date(now),
1390 header_fields(HdrExtra, _),
1391 ( {memberchk(transfer_encoding(_), HdrExtra)}
1392 -> ""
1393 ; transfer_encoding(chunked)
1394 ),
1395 "\r\n".
1397reply_header(status(Status), HdrExtra, Code) -->
1398 vstatus(Status, Code),
1399 header_fields(HdrExtra, Clen),
1400 { Clen = 0 },
1401 "\r\n".
1403reply_header(Data, HdrExtra, Code) -->
1404 { status_reply_headers(Data,
1405 body(Type, Encoding, Content),
1406 ReplyHeaders),
1407 http_join_headers(ReplyHeaders, HdrExtra, Headers),
1408 functor(Data, CodeName, _)
1409 },
1410 vstatus(CodeName, Code, Headers),
1411 date(now),
1412 header_fields(Headers, CLen),
1413 content_length(codes(Content, Encoding), CLen),
1414 content_type(Type, Encoding),
1415 "\r\n".
1416
(created(Location, Body), Body,
1418 [ location(Location) ]).
1419status_reply_headers(moved(To, Body), Body,
1420 [ location(To) ]).
1421status_reply_headers(moved_temporary(To, Body), Body,
1422 [ location(To) ]).
1423status_reply_headers(gone(_URL, Body), Body, []).
1424status_reply_headers(see_other(To, Body), Body,
1425 [ location(To) ]).
1426status_reply_headers(authorise(Method, Body), Body,
1427 [ www_authenticate(Method) ]).
1428status_reply_headers(not_found(_URL, Body), Body, []).
1429status_reply_headers(forbidden(_URL, Body), Body, []).
1430status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
1431status_reply_headers(server_error(_Error, Body), Body, []).
1432status_reply_headers(service_unavailable(_Why, Body), Body, []).
1433status_reply_headers(not_acceptable(_Why, Body), Body, []).
1434status_reply_headers(bad_request(_Error, Body), Body, []).
1435
1436
1441
1442vstatus(_Status, Code, HdrExtra) -->
1443 {memberchk(status(Code), HdrExtra)},
1444 !,
1445 vstatus(_NewStatus, Code).
1446vstatus(Status, Code, _) -->
1447 vstatus(Status, Code).
1448
1449vstatus(Status, Code) -->
1450 "HTTP/1.1 ",
1451 status_number(Status, Code),
1452 " ",
1453 status_comment(Status),
1454 "\r\n".
1455
1462
1463status_number(Status, Code) -->
1464 { var(Status) },
1465 !,
1466 integer(Code),
1467 { status_number(Status, Code) },
1468 !.
1469status_number(Status, Code) -->
1470 { status_number(Status, Code) },
1471 integer(Code).
1472
1484
1492
1493status_number(Status, Code) :-
1494 nonvar(Status),
1495 !,
1496 status_number_fact(Status, Code).
1497status_number(Status, Code) :-
1498 nonvar(Code),
1499 !,
1500 ( between(100, 599, Code)
1501 -> ( status_number_fact(Status, Code)
1502 -> true
1503 ; ClassCode is Code // 100 * 100,
1504 status_number_fact(Status, ClassCode)
1505 )
1506 ; domain_error(http_code, Code)
1507 ).
1508
1509status_number_fact(continue, 100).
1510status_number_fact(switching_protocols, 101).
1511status_number_fact(ok, 200).
1512status_number_fact(created, 201).
1513status_number_fact(accepted, 202).
1514status_number_fact(non_authoritative_info, 203).
1515status_number_fact(no_content, 204).
1516status_number_fact(reset_content, 205).
1517status_number_fact(partial_content, 206).
1518status_number_fact(multiple_choices, 300).
1519status_number_fact(moved, 301).
1520status_number_fact(moved_temporary, 302).
1521status_number_fact(see_other, 303).
1522status_number_fact(not_modified, 304).
1523status_number_fact(use_proxy, 305).
1524status_number_fact(unused, 306).
1525status_number_fact(temporary_redirect, 307).
1526status_number_fact(bad_request, 400).
1527status_number_fact(authorise, 401).
1528status_number_fact(payment_required, 402).
1529status_number_fact(forbidden, 403).
1530status_number_fact(not_found, 404).
1531status_number_fact(method_not_allowed, 405).
1532status_number_fact(not_acceptable, 406).
1533status_number_fact(request_timeout, 408).
1534status_number_fact(conflict, 409).
1535status_number_fact(gone, 410).
1536status_number_fact(length_required, 411).
1537status_number_fact(payload_too_large, 413).
1538status_number_fact(uri_too_long, 414).
1539status_number_fact(unsupported_media_type, 415).
1540status_number_fact(expectation_failed, 417).
1541status_number_fact(upgrade_required, 426).
1542status_number_fact(server_error, 500).
1543status_number_fact(not_implemented, 501).
1544status_number_fact(bad_gateway, 502).
1545status_number_fact(service_unavailable, 503).
1546status_number_fact(gateway_timeout, 504).
1547status_number_fact(http_version_not_supported, 505).
1548
1549
1553
(continue) -->
1555 "Continue".
1556status_comment(switching_protocols) -->
1557 "Switching Protocols".
1558status_comment(ok) -->
1559 "OK".
1560status_comment(created) -->
1561 "Created".
1562status_comment(accepted) -->
1563 "Accepted".
1564status_comment(non_authoritative_info) -->
1565 "Non-Authoritative Information".
1566status_comment(no_content) -->
1567 "No Content".
1568status_comment(reset_content) -->
1569 "Reset Content".
1570status_comment(created) -->
1571 "Created".
1572status_comment(partial_content) -->
1573 "Partial content".
1574status_comment(multiple_choices) -->
1575 "Multiple Choices".
1576status_comment(moved) -->
1577 "Moved Permanently".
1578status_comment(moved_temporary) -->
1579 "Moved Temporary".
1580status_comment(see_other) -->
1581 "See Other".
1582status_comment(not_modified) -->
1583 "Not Modified".
1584status_comment(use_proxy) -->
1585 "Use Proxy".
1586status_comment(unused) -->
1587 "Unused".
1588status_comment(temporary_redirect) -->
1589 "Temporary Redirect".
1590status_comment(bad_request) -->
1591 "Bad Request".
1592status_comment(authorise) -->
1593 "Authorization Required".
1594status_comment(payment_required) -->
1595 "Payment Required".
1596status_comment(forbidden) -->
1597 "Forbidden".
1598status_comment(not_found) -->
1599 "Not Found".
1600status_comment(method_not_allowed) -->
1601 "Method Not Allowed".
1602status_comment(not_acceptable) -->
1603 "Not Acceptable".
1604status_comment(request_timeout) -->
1605 "Request Timeout".
1606status_comment(conflict) -->
1607 "Conflict".
1608status_comment(gone) -->
1609 "Gone".
1610status_comment(length_required) -->
1611 "Length Required".
1612status_comment(payload_too_large) -->
1613 "Payload Too Large".
1614status_comment(uri_too_long) -->
1615 "URI Too Long".
1616status_comment(unsupported_media_type) -->
1617 "Unsupported Media Type".
1618status_comment(expectation_failed) -->
1619 "Expectation Failed".
1620status_comment(upgrade_required) -->
1621 "Upgrade Required".
1622status_comment(server_error) -->
1623 "Internal Server Error".
1624status_comment(not_implemented) -->
1625 "Not Implemented".
1626status_comment(bad_gateway) -->
1627 "Bad Gateway".
1628status_comment(service_unavailable) -->
1629 "Service Unavailable".
1630status_comment(gateway_timeout) -->
1631 "Gateway Timeout".
1632status_comment(http_version_not_supported) -->
1633 "HTTP Version Not Supported".
1634
1635date(Time) -->
1636 "Date: ",
1637 ( { Time == now }
1638 -> now
1639 ; rfc_date(Time)
1640 ),
1641 "\r\n".
1642
1643modified(file(File)) -->
1644 !,
1645 { time_file(File, Time)
1646 },
1647 modified(Time).
1648modified(Time) -->
1649 "Last-modified: ",
1650 ( { Time == now }
1651 -> now
1652 ; rfc_date(Time)
1653 ),
1654 "\r\n".
1655
1656
1663
1664content_length(file(File, bytes(From, To)), Len) -->
1665 !,
1666 { size_file(File, Size),
1667 ( To == end
1668 -> Len is Size - From,
1669 RangeEnd is Size - 1
1670 ; Len is To+1 - From, 1671 RangeEnd = To
1672 )
1673 },
1674 content_range(bytes, From, RangeEnd, Size),
1675 content_length(Len, Len).
1676content_length(Reply, Len) -->
1677 { length_of(Reply, Len)
1678 },
1679 "Content-Length: ", integer(Len),
1680 "\r\n".
1681
1682:- meta_predicate
1683 print_length(0, -, +, -). 1684
1685:- det(length_of/2). 1686length_of(_, Len), integer(Len) => true.
1687length_of(string(String, Encoding), Len) =>
1688 length_of(codes(String, Encoding), Len).
1689length_of(codes(String, Encoding), Len) =>
1690 print_length(format(Out, '~s', [String]), Out, Encoding, Len).
1691length_of(atom(Atom, Encoding), Len) =>
1692 print_length(format(Out, '~a', [Atom]), Out, Encoding, Len).
1693length_of(file(File), Len) =>
1694 size_file(File, Len).
1695length_of(memory_file(Handle), Len) =>
1696 size_memory_file(Handle, Len, octet).
1697length_of(html_tokens(Tokens), Len) =>
1698 html_print_length(Tokens, Len).
1699length_of(html(Tokens, Encoding), Len) =>
1700 print_length(print_html(Out, Tokens), Out, Encoding, Len).
1701length_of(bytes(Bytes), Len) =>
1702 print_length(format(Out, '~s', [Bytes]), Out, octet, Len).
1703length_of(Num, Len), integer(Num) =>
1704 Len = Num.
1705
1706print_length(Goal, Out, Encoding, Len) :-
1707 setup_call_cleanup(
1708 open_null_stream(Out),
1709 ( set_stream(Out, encoding(Encoding)),
1710 call(Goal),
1711 byte_count(Out, Len)
1712 ),
1713 close(Out)).
1714
1719
1720content_range(Unit, From, RangeEnd, Size) -->
1721 "Content-Range: ", atom(Unit), " ",
1722 integer(From), "-", integer(RangeEnd), "/", integer(Size),
1723 "\r\n".
1724
1725content_encoding(Encoding) -->
1726 "Content-Encoding: ", atom(Encoding), "\r\n".
1727
1728transfer_encoding(Encoding) -->
1729 "Transfer-Encoding: ", atom(Encoding), "\r\n".
1730
1731content_type(Type) -->
1732 content_type(Type, _).
1733
1734content_type(Type, Charset) -->
1735 ctype(Type),
1736 charset(Charset),
1737 "\r\n".
1738
1739ctype(Main/Sub) -->
1740 !,
1741 "Content-Type: ",
1742 atom(Main),
1743 "/",
1744 atom(Sub).
1745ctype(Type) -->
1746 !,
1747 "Content-Type: ",
1748 atom(Type).
1749
1750charset(Var) -->
1751 { var(Var) },
1752 !.
1753charset(utf8) -->
1754 !,
1755 "; charset=UTF-8".
1756charset(CharSet) -->
1757 "; charset=",
1758 atom(CharSet).
1759
1765
(Name, Value) -->
1767 { var(Name) }, 1768 !,
1769 field_name(Name),
1770 ":",
1771 whites,
1772 read_field_value(ValueChars),
1773 blanks_to_nl,
1774 !,
1775 { field_to_prolog(Name, ValueChars, Value)
1776 -> true
1777 ; atom_codes(Value, ValueChars),
1778 domain_error(Name, Value)
1779 }.
1780header_field(Name, Value) -->
1781 field_name(Name),
1782 ": ",
1783 field_value(Name, Value),
1784 "\r\n".
1785
1789
1790read_field_value([H|T]) -->
1791 [H],
1792 { \+ code_type(H, space) },
1793 !,
1794 read_field_value(T).
1795read_field_value([]) -->
1796 "".
1797read_field_value([H|T]) -->
1798 [H],
1799 read_field_value(T).
1800
1805
(Out, String) :-
1807 debug(http(send_reply), "< ~s", [String]),
1808 format(Out, '~s', [String]).
1809
(Out, String) :-
1811 debug(http(send_request), "> ~s", [String]),
1812 format(Out, '~s', [String]).
1813
1853
(Field, Value, Prolog) :-
1855 known_field(Field, _, Type),
1856 ( already_parsed(Type, Value)
1857 -> Prolog = Value
1858 ; parse_header_value_atom(Field, Value, Prolog)
1859 -> true
1860 ; to_codes(Value, Codes),
1861 parse_header_value(Field, Codes, Prolog)
1862 ).
1863
1864already_parsed(integer, V) :- !, integer(V).
1865already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
1866already_parsed(Term, V) :- subsumes_term(Term, V).
1867
1868
1873
1874known_field(content_length, true, integer).
1875known_field(status, true, integer).
1876known_field(expires, false, number).
1877known_field(cookie, true, list(_=_)).
1878known_field(set_cookie, true, list(set_cookie(_Name,_Value,_Options))).
1879known_field(host, true, _Host:_Port).
1880known_field(range, maybe, bytes(_,_)).
1881known_field(accept, maybe, list(media(_Type, _Parms, _Q, _Exts))).
1882known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
1883known_field(content_type, false, media(_Type/_Sub, _Attributes)).
1884
1885to_codes(In, Codes) :-
1886 ( is_list(In)
1887 -> Codes = In
1888 ; atom_codes(In, Codes)
1889 ).
1890
1896
1897field_to_prolog(Field, Codes, Prolog) :-
1898 known_field(Field, true, _Type),
1899 !,
1900 ( parse_header_value(Field, Codes, Prolog0)
1901 -> Prolog = Prolog0
1902 ).
1903field_to_prolog(Field, Codes, Prolog) :-
1904 known_field(Field, maybe, _Type),
1905 parse_header_value(Field, Codes, Prolog0),
1906 !,
1907 Prolog = Prolog0.
1908field_to_prolog(_, Codes, Atom) :-
1909 atom_codes(Atom, Codes).
1910
1914
(content_length, Atom, ContentLength) :-
1916 atomic(Atom),
1917 atom_number(Atom, ContentLength).
1918parse_header_value_atom(expires, Atom, Stamp) :-
1919 http_timestamp(Stamp, Atom).
1920
1925
(content_length, ValueChars, ContentLength) :-
1927 number_codes(ContentLength, ValueChars).
1928parse_header_value(expires, ValueCodes, Stamp) :-
1929 http_timestamp(Stamp, ValueCodes).
1930parse_header_value(status, ValueChars, Code) :-
1931 ( phrase(" ", L, _),
1932 append(Pre, L, ValueChars)
1933 -> number_codes(Code, Pre)
1934 ; number_codes(Code, ValueChars)
1935 ).
1936parse_header_value(cookie, ValueChars, Cookies) :-
1937 debug(cookie, 'Cookie: ~s', [ValueChars]),
1938 phrase(cookies(Cookies), ValueChars).
1939parse_header_value(set_cookie, ValueChars, SetCookie) :-
1940 debug(cookie, 'SetCookie: ~s', [ValueChars]),
1941 phrase(set_cookie(SetCookie), ValueChars).
1942parse_header_value(host, ValueChars, Host) :-
1943 ( append(HostChars, [0':|PortChars], ValueChars),
1944 catch(number_codes(Port, PortChars), _, fail)
1945 -> atom_codes(HostName, HostChars),
1946 Host = HostName:Port
1947 ; atom_codes(Host, ValueChars)
1948 ).
1949parse_header_value(range, ValueChars, Range) :-
1950 phrase(range(Range), ValueChars).
1951parse_header_value(accept, ValueChars, Media) :-
1952 parse_accept(ValueChars, Media).
1953parse_header_value(content_disposition, ValueChars, Disposition) :-
1954 phrase(content_disposition(Disposition), ValueChars).
1955parse_header_value(content_type, ValueChars, Type) :-
1956 phrase(parse_content_type(Type), ValueChars).
1957
1959
1960field_value(_, set_cookie(Name, Value, Options)) -->
1961 !,
1962 atom(Name), "=", atom(Value),
1963 value_options(Options, cookie).
1964field_value(_, disposition(Disposition, Options)) -->
1965 !,
1966 atom(Disposition), value_options(Options, disposition).
1967field_value(www_authenticate, Auth) -->
1968 auth_field_value(Auth).
1969field_value(_, Atomic) -->
1970 atom(Atomic).
1971
1975
1976auth_field_value(negotiate(Data)) -->
1977 "Negotiate ",
1978 { base64(Data, DataBase64),
1979 atom_codes(DataBase64, Codes)
1980 },
1981 string(Codes).
1982auth_field_value(negotiate) -->
1983 "Negotiate".
1984auth_field_value(basic) -->
1985 !,
1986 "Basic".
1987auth_field_value(basic(Realm)) -->
1988 "Basic Realm=\"", atom(Realm), "\"".
1989auth_field_value(digest) -->
1990 !,
1991 "Digest".
1992auth_field_value(digest(Details)) -->
1993 "Digest ", atom(Details).
1994
2001
2002value_options([], _) --> [].
2003value_options([H|T], Field) -->
2004 "; ", value_option(H, Field),
2005 value_options(T, Field).
2006
2007value_option(secure=true, cookie) -->
2008 !,
2009 "secure".
2010value_option(Name=Value, Type) -->
2011 { string_option(Name, Type) },
2012 !,
2013 atom(Name), "=",
2014 qstring(Value).
2015value_option(Name=Value, Type) -->
2016 { token_option(Name, Type) },
2017 !,
2018 atom(Name), "=", atom(Value).
2019value_option(Name=Value, _Type) -->
2020 atom(Name), "=",
2021 option_value(Value).
2022
2023string_option(filename, disposition).
2024
2025token_option(path, cookie).
2026
2027option_value(Value) -->
2028 { number(Value) },
2029 !,
2030 number(Value).
2031option_value(Value) -->
2032 { ( atom(Value)
2033 -> true
2034 ; string(Value)
2035 ),
2036 forall(string_code(_, Value, C),
2037 token_char(C))
2038 },
2039 !,
2040 atom(Value).
2041option_value(Atomic) -->
2042 qstring(Atomic).
2043
2044qstring(Atomic) -->
2045 { string_codes(Atomic, Codes) },
2046 "\"",
2047 qstring_codes(Codes),
2048 "\"".
2049
2050qstring_codes([]) --> [].
2051qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
2052
2053qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
2054qstring_code(C) --> [C].
2055
2056qstring_esc(0'").
2057qstring_esc(C) :- ctl(C).
2058
2059
2060 2063
2064:- dynamic accept_cache/2. 2065:- volatile accept_cache/2. 2066
2067parse_accept(Codes, Media) :-
2068 atom_codes(Atom, Codes),
2069 ( accept_cache(Atom, Media0)
2070 -> Media = Media0
2071 ; phrase(accept(Media0), Codes),
2072 keysort(Media0, Media1),
2073 pairs_values(Media1, Media2),
2074 assertz(accept_cache(Atom, Media2)),
2075 Media = Media2
2076 ).
2077
2081
2082accept([H|T]) -->
2083 blanks,
2084 media_range(H),
2085 blanks,
2086 ( ","
2087 -> accept(T)
2088 ; {T=[]}
2089 ).
2090
2091media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
2092 media_type(Type),
2093 blanks,
2094 ( ";"
2095 -> blanks,
2096 parameters_and_quality(TypeParams, Quality, AcceptExts)
2097 ; { TypeParams = [],
2098 Quality = 1.0,
2099 AcceptExts = []
2100 }
2101 ),
2102 { SortQuality is float(-Quality),
2103 rank_specialised(Type, TypeParams, Spec)
2104 }.
2105
2106
2110
2111content_disposition(disposition(Disposition, Options)) -->
2112 token(Disposition), blanks,
2113 value_parameters(Options).
2114
2119
2120parse_content_type(media(Type, Parameters)) -->
2121 media_type(Type), blanks,
2122 value_parameters(Parameters).
2123
2124
2132
2133rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
2134 var_or_given(Type, VT),
2135 var_or_given(SubType, VS),
2136 length(TypeParams, VP),
2137 SortVP is -VP.
2138
2139var_or_given(V, Val) :-
2140 ( var(V)
2141 -> Val = 0
2142 ; Val = -1
2143 ).
2144
2145media_type(Type/SubType) -->
2146 type(Type), "/", type(SubType).
2147
2148type(_) -->
2149 "*",
2150 !.
2151type(Type) -->
2152 token(Type).
2153
2154parameters_and_quality(Params, Quality, AcceptExts) -->
2155 token(Name),
2156 blanks, "=", blanks,
2157 ( { Name == q }
2158 -> float(Quality), blanks,
2159 value_parameters(AcceptExts),
2160 { Params = [] }
2161 ; { Params = [Name=Value|T] },
2162 parameter_value(Value),
2163 blanks,
2164 ( ";"
2165 -> blanks,
2166 parameters_and_quality(T, Quality, AcceptExts)
2167 ; { T = [],
2168 Quality = 1.0,
2169 AcceptExts = []
2170 }
2171 )
2172 ).
2173
2178
2179value_parameters([H|T]) -->
2180 ";",
2181 !,
2182 blanks, token(Name), blanks,
2183 ( "="
2184 -> blanks,
2185 ( token(Value)
2186 -> []
2187 ; quoted_string(Value)
2188 ),
2189 { H = (Name=Value) }
2190 ; { H = Name }
2191 ),
2192 blanks,
2193 value_parameters(T).
2194value_parameters([]) -->
2195 [].
2196
2197parameter_value(Value) --> token(Value), !.
2198parameter_value(Value) --> quoted_string(Value).
2199
2200
2204
2205token(Name) -->
2206 token_char(C1),
2207 token_chars(Cs),
2208 { atom_codes(Name, [C1|Cs]) }.
2209
2210token_chars([H|T]) -->
2211 token_char(H),
2212 !,
2213 token_chars(T).
2214token_chars([]) --> [].
2215
2216token_char(C) :-
2217 \+ ctl(C),
2218 \+ separator_code(C).
2219
2220ctl(C) :- between(0,31,C), !.
2221ctl(127).
2222
2223separator_code(0'().
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'\s).
2241separator_code(0'\t).
2242
2243term_expansion(token_char(x) --> [x], Clauses) :-
2244 findall((token_char(C)-->[C]),
2245 ( between(0, 255, C),
2246 token_char(C)
2247 ),
2248 Clauses).
2249
2250token_char(x) --> [x].
2251
2255
2256quoted_string(Text) -->
2257 "\"",
2258 quoted_text(Codes),
2259 { atom_codes(Text, Codes) }.
2260
2261quoted_text([]) -->
2262 "\"",
2263 !.
2264quoted_text([H|T]) -->
2265 "\\", !, [H],
2266 quoted_text(T).
2267quoted_text([H|T]) -->
2268 [H],
2269 !,
2270 quoted_text(T).
2271
2272
2280
([], _) --> [].
2282header_fields([content_length(CLen)|T], CLen) -->
2283 !,
2284 ( { var(CLen) }
2285 -> ""
2286 ; header_field(content_length, CLen)
2287 ),
2288 header_fields(T, CLen). 2289header_fields([status(_)|T], CLen) --> 2290 !,
2291 header_fields(T, CLen).
2292header_fields([H|T], CLen) -->
2293 { H =.. [Name, Value] },
2294 header_field(Name, Value),
2295 header_fields(T, CLen).
2296
2297
2311
2312:- public
2313 field_name//1. 2314
2315field_name(Name) -->
2316 { var(Name) },
2317 !,
2318 rd_field_chars(Chars),
2319 { atom_codes(Name, Chars) }.
2320field_name(mime_version) -->
2321 !,
2322 "MIME-Version".
2323field_name(www_authenticate) -->
2324 !,
2325 "WWW-Authenticate".
2326field_name(Name) -->
2327 { atom_codes(Name, Chars) },
2328 wr_field_chars(Chars).
2329
2330rd_field_chars_no_fold([C|T]) -->
2331 [C],
2332 { rd_field_char(C, _) },
2333 !,
2334 rd_field_chars_no_fold(T).
2335rd_field_chars_no_fold([]) -->
2336 [].
2337
2338rd_field_chars([C0|T]) -->
2339 [C],
2340 { rd_field_char(C, C0) },
2341 !,
2342 rd_field_chars(T).
2343rd_field_chars([]) -->
2344 [].
2345
2349
2350separators("()<>@,;:\\\"/[]?={} \t").
2351
2352term_expansion(rd_field_char('expand me',_), Clauses) :-
2353
2354 Clauses = [ rd_field_char(0'-, 0'_)
2355 | Cls
2356 ],
2357 separators(SepString),
2358 string_codes(SepString, Seps),
2359 findall(rd_field_char(In, Out),
2360 ( between(32, 127, In),
2361 \+ memberchk(In, Seps),
2362 In \== 0'-, 2363 code_type(Out, to_lower(In))),
2364 Cls).
2365
2366rd_field_char('expand me', _). 2367
2368wr_field_chars([C|T]) -->
2369 !,
2370 { code_type(C, to_lower(U)) },
2371 [U],
2372 wr_field_chars2(T).
2373wr_field_chars([]) -->
2374 [].
2375
2376wr_field_chars2([]) --> [].
2377wr_field_chars2([C|T]) --> 2378 ( { C == 0'_ }
2379 -> "-",
2380 wr_field_chars(T)
2381 ; [C],
2382 wr_field_chars2(T)
2383 ).
2384
2388
2389now -->
2390 { get_time(Time)
2391 },
2392 rfc_date(Time).
2393
2398
2399rfc_date(Time, String, Tail) :-
2400 stamp_date_time(Time, Date, 'UTC'),
2401 format_time(codes(String, Tail),
2402 '%a, %d %b %Y %T GMT',
2403 Date, posix).
2404
2413
2414http_timestamp(Time, Text), nonvar(Text) =>
2415 ( parse_time(Text, _Format, Time0)
2416 -> ( var(Time)
2417 -> Time = Time0
2418 ; Time =:= Time0
2419 )
2420 ; syntax_error(http_timestamp(Text))
2421 ).
2422http_timestamp(Time, Atom), number(Time) =>
2423 stamp_date_time(Time, Date, 'UTC'),
2424 format_time(atom(Atom),
2425 '%a, %d %b %Y %T GMT',
2426 Date, posix).
2427
2428
2429 2432
2433request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
2434 method(Method),
2435 blanks,
2436 nonblanks(Query),
2437 { atom_codes(ReqURI, Query),
2438 request_uri_parts(ReqURI, Header, Rest)
2439 },
2440 request_header(Fd, Rest),
2441 !.
2442request(Fd, [unknown(What)|Header]) -->
2443 string(What),
2444 eos,
2445 !,
2446 { http_read_header(Fd, Header)
2447 -> true
2448 ; Header = []
2449 }.
2450
2451method(get) --> "GET", !.
2452method(put) --> "PUT", !.
2453method(head) --> "HEAD", !.
2454method(post) --> "POST", !.
2455method(delete) --> "DELETE", !.
2456method(patch) --> "PATCH", !.
2457method(options) --> "OPTIONS", !.
2458method(trace) --> "TRACE", !.
2459
2471
2472request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
2473 uri_components(ReqURI, Components),
2474 uri_data(path, Components, PathText),
2475 uri_encoded(path, Path, PathText),
2476 phrase(uri_parts(Components), Parts, Rest).
2477
2478uri_parts(Components) -->
2479 uri_search(Components),
2480 uri_fragment(Components).
2481
2482uri_search(Components) -->
2483 { uri_data(search, Components, Search),
2484 nonvar(Search),
2485 catch(uri_query_components(Search, Query),
2486 error(syntax_error(_),_),
2487 fail)
2488 },
2489 !,
2490 [ search(Query) ].
2491uri_search(_) --> [].
2492
2493uri_fragment(Components) -->
2494 { uri_data(fragment, Components, String),
2495 nonvar(String),
2496 !,
2497 uri_encoded(fragment, Fragment, String)
2498 },
2499 [ fragment(Fragment) ].
2500uri_fragment(_) --> [].
2501
2506
(_, []) --> 2508 blanks,
2509 eos,
2510 !.
2511request_header(Fd, [http_version(Version)|Header]) -->
2512 http_version(Version),
2513 blanks,
2514 eos,
2515 !,
2516 { Version = 1-_
2517 -> http_read_header(Fd, Header)
2518 ; Header = []
2519 }.
2520
2521http_version(Version) -->
2522 blanks,
2523 "HTTP/",
2524 http_version_number(Version).
2525
2526http_version_number(Major-Minor) -->
2527 integer(Major),
2528 ".",
2529 integer(Minor).
2530
2531
2532 2535
2539
2540cookies([Name=Value|T]) -->
2541 blanks,
2542 cookie(Name, Value),
2543 !,
2544 blanks,
2545 ( ";"
2546 -> cookies(T)
2547 ; { T = [] }
2548 ).
2549cookies(List) -->
2550 string(Skipped),
2551 ";",
2552 !,
2553 { print_message(warning, http(skipped_cookie(Skipped))) },
2554 cookies(List).
2555cookies([]) -->
2556 blanks.
2557
2558cookie(Name, Value) -->
2559 cookie_name(Name),
2560 blanks, "=", blanks,
2561 cookie_value(Value).
2562
2563cookie_name(Name) -->
2564 { var(Name) },
2565 !,
2566 rd_field_chars_no_fold(Chars),
2567 { atom_codes(Name, Chars) }.
2568
2569cookie_value(Value) -->
2570 quoted_string(Value),
2571 !.
2572cookie_value(Value) -->
2573 chars_to_semicolon_or_blank(Chars),
2574 { atom_codes(Value, Chars)
2575 }.
2576
2577chars_to_semicolon_or_blank([]), ";" -->
2578 ";",
2579 !.
2580chars_to_semicolon_or_blank([]) -->
2581 " ",
2582 blanks,
2583 eos,
2584 !.
2585chars_to_semicolon_or_blank([H|T]) -->
2586 [H],
2587 !,
2588 chars_to_semicolon_or_blank(T).
2589chars_to_semicolon_or_blank([]) -->
2590 [].
2591
2592set_cookie(set_cookie(Name, Value, Options)) -->
2593 ws,
2594 cookie(Name, Value),
2595 cookie_options(Options).
2596
2597cookie_options([H|T]) -->
2598 ws,
2599 ";",
2600 ws,
2601 cookie_option(H),
2602 !,
2603 cookie_options(T).
2604cookie_options([]) -->
2605 ws.
2606
2607ws --> " ", !, ws.
2608ws --> [].
2609
2610
2619
2620cookie_option(Name=Value) -->
2621 rd_field_chars(NameChars), ws,
2622 { atom_codes(Name, NameChars) },
2623 ( "="
2624 -> ws,
2625 chars_to_semicolon(ValueChars),
2626 { atom_codes(Value, ValueChars)
2627 }
2628 ; { Value = true }
2629 ).
2630
2631chars_to_semicolon([H|T]) -->
2632 [H],
2633 { H \== 32, H \== 0'; },
2634 !,
2635 chars_to_semicolon(T).
2636chars_to_semicolon([]), ";" -->
2637 ws, ";",
2638 !.
2639chars_to_semicolon([H|T]) -->
2640 [H],
2641 chars_to_semicolon(T).
2642chars_to_semicolon([]) -->
2643 [].
2644
2652
2653range(bytes(From, To)) -->
2654 "bytes", whites, "=", whites, integer(From), "-",
2655 ( integer(To)
2656 -> ""
2657 ; { To = end }
2658 ).
2659
2660
2661 2664
2679
2680reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
2681 http_version(HttpVersion),
2682 blanks,
2683 ( status_number(Status, Code)
2684 -> []
2685 ; integer(Status)
2686 ),
2687 blanks,
2688 string(CommentCodes),
2689 blanks_to_nl,
2690 !,
2691 blanks,
2692 { atom_codes(Comment, CommentCodes),
2693 http_read_header(Fd, Header)
2694 }.
2695
2696
2697 2700
2706
(Fd, Header) :-
2708 read_header_data(Fd, Text),
2709 http_parse_header(Text, Header).
2710
(Fd, Header) :-
2712 read_line_to_codes(Fd, Header, Tail),
2713 read_header_data(Header, Fd, Tail),
2714 debug(http(header), 'Header = ~n~s~n', [Header]).
2715
([0'\r,0'\n], _, _) :- !.
2717read_header_data([0'\n], _, _) :- !.
2718read_header_data([], _, _) :- !.
2719read_header_data(_, Fd, Tail) :-
2720 read_line_to_codes(Fd, Tail, NewTail),
2721 read_header_data(Tail, Fd, NewTail).
2722
2729
(Text, Header) :-
2731 phrase(header(Header), Text),
2732 debug(http(header), 'Field: ~p', [Header]).
2733
(List) -->
2735 header_field(Name, Value),
2736 !,
2737 { mkfield(Name, Value, List, Tail)
2738 },
2739 blanks,
2740 header(Tail).
2741header([]) -->
2742 blanks,
2743 eos,
2744 !.
2745header(_) -->
2746 string(S), blanks_to_nl,
2747 !,
2748 { string_codes(Line, S),
2749 syntax_error(http_parameter(Line))
2750 }.
2751
2763
2764:- multifile
2765 http:http_address//0. 2766
2767address -->
2768 http:http_address,
2769 !.
2770address -->
2771 { gethostname(Host) },
2772 html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
2773 ' httpd at ', Host
2774 ])).
2775
2776mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
2777mkfield(Name, Value, [Att|Tail], Tail) :-
2778 Att =.. [Name, Value].
2779
2785
2815
2816
2817 2820
2821:- multifile
2822 prolog:message//1,
2823 prolog:error_message//1. 2824
2825prolog:error_message(http_write_short(Data, Sent)) -->
2826 data(Data),
2827 [ ': remote hangup after ~D bytes'-[Sent] ].
2828prolog:error_message(syntax_error(http_request(Request))) -->
2829 [ 'Illegal HTTP request: ~s'-[Request] ].
2830prolog:error_message(syntax_error(http_parameter(Line))) -->
2831 [ 'Illegal HTTP parameter: ~s'-[Line] ].
2832
2833prolog:message(http(skipped_cookie(S))) -->
2834 [ 'Skipped illegal cookie: ~s'-[S] ].
2835
2836data(bytes(MimeType, _Bytes)) -->
2837 !,
2838 [ 'bytes(~p, ...)'-[MimeType] ].
2839data(Data) -->
2840 [ '~p'-[Data] ]