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 html(a(href(URL), Label)),
744 html_message_lines(T).
745html_message_lines([Fmt-Args|T]) -->
746 !,
747 { format(string(S), Fmt, Args)
748 },
749 html([S]),
750 html_message_lines(T).
751html_message_lines([Fmt|T]) -->
752 !,
753 { format(string(S), Fmt, [])
754 },
755 html([S]),
756 html_message_lines(T).
757
758msg_url(File:Line:Pos) -->
759 !,
760 html([File, :, Line, :, Pos]).
761msg_url(File:Line) -->
762 !,
763 html([File, :, Line]).
764msg_url(File) -->
765 html([File]).
766
771
([], H, H).
773http_join_headers([H|T], Hdr0, Hdr) :-
774 functor(H, N, A),
775 functor(H2, N, A),
776 member(H2, Hdr0),
777 !,
778 http_join_headers(T, Hdr0, Hdr).
779http_join_headers([H|T], Hdr0, [H|Hdr]) :-
780 http_join_headers(T, Hdr0, Hdr).
781
782
791
792http_update_encoding(Header0, Encoding, Header) :-
793 memberchk(content_type(Type), Header0),
794 !,
795 http_update_encoding(Type, Header0, Encoding, Header).
796http_update_encoding(Header, octet, Header).
797
798http_update_encoding('text/event-stream', Header, utf8, Header) :-
799 !.
800http_update_encoding(Type0, Header0, utf8, [content_type(Type)|Header]) :-
801 sub_atom(Type0, 0, _, _, 'text/'),
802 !,
803 select(content_type(_), Header0, Header),
804 !,
805 ( sub_atom(Type0, S, _, _, ';')
806 -> sub_atom(Type0, 0, S, _, B)
807 ; B = Type0
808 ),
809 atom_concat(B, '; charset=UTF-8', Type).
810http_update_encoding(Type, Header, Encoding, Header) :-
811 ( sub_atom_icasechk(Type, _, 'utf-8')
812 -> Encoding = utf8
813 ; http:mime_type_encoding(Type, Encoding)
814 -> true
815 ; mime_type_encoding(Type, Encoding)
816 -> true
817 ; Encoding = octet
818 ).
819
824
825mime_type_encoding('application/json', utf8).
826mime_type_encoding('application/jsonrequest', utf8).
827mime_type_encoding('application/x-prolog', utf8).
828mime_type_encoding('application/n-quads', utf8).
829mime_type_encoding('application/n-triples', utf8).
830mime_type_encoding('application/sparql-query', utf8).
831mime_type_encoding('application/trig', utf8).
832mime_type_encoding('application/sparql-results+json', utf8).
833mime_type_encoding('application/sparql-results+xml', utf8).
834
842
843
848
849http_update_connection(CgiHeader, Request, Connect,
850 [connection(Connect)|Rest]) :-
851 select(connection(CgiConn), CgiHeader, Rest),
852 !,
853 connection(Request, ReqConnection),
854 join_connection(ReqConnection, CgiConn, Connect).
855http_update_connection(CgiHeader, Request, Connect,
856 [connection(Connect)|CgiHeader]) :-
857 connection(Request, Connect).
858
859join_connection(Keep1, Keep2, Connection) :-
860 ( downcase_atom(Keep1, 'keep-alive'),
861 downcase_atom(Keep2, 'keep-alive')
862 -> Connection = 'Keep-Alive'
863 ; Connection = close
864 ).
865
866
870
871connection(Header, Close) :-
872 ( memberchk(connection(Connection), Header)
873 -> Close = Connection
874 ; memberchk(http_version(1-X), Header),
875 X >= 1
876 -> Close = 'Keep-Alive'
877 ; Close = close
878 ).
879
880
896
897http_update_transfer(Request, CgiHeader, Transfer, Header) :-
898 setting(http:chunked_transfer, When),
899 http_update_transfer(When, Request, CgiHeader, Transfer, Header).
900
901http_update_transfer(never, _, CgiHeader, none, Header) :-
902 !,
903 delete(CgiHeader, transfer_encoding(_), Header).
904http_update_transfer(_, _, CgiHeader, none, Header) :-
905 memberchk(location(_), CgiHeader),
906 !,
907 delete(CgiHeader, transfer_encoding(_), Header).
908http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
909 select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
910 !,
911 transfer(Request, ReqConnection),
912 join_transfer(ReqConnection, CgiTransfer, Transfer),
913 ( Transfer == none
914 -> Header = Rest
915 ; Header = [transfer_encoding(Transfer)|Rest]
916 ).
917http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
918 transfer(Request, Transfer),
919 Transfer \== none,
920 !,
921 Header = [transfer_encoding(Transfer)|CgiHeader].
922http_update_transfer(_, _, CgiHeader, event_stream, CgiHeader) :-
923 memberchk(content_type('text/event-stream'), CgiHeader),
924 !.
925http_update_transfer(_, _, CgiHeader, none, CgiHeader).
926
927join_transfer(chunked, chunked, chunked) :- !.
928join_transfer(_, _, none).
929
930
934
935transfer(Header, Transfer) :-
936 ( memberchk(transfer_encoding(Transfer0), Header)
937 -> Transfer = Transfer0
938 ; memberchk(http_version(1-X), Header),
939 X >= 1
940 -> Transfer = chunked
941 ; Transfer = none
942 ).
943
944
950
951content_length_in_encoding(Enc, Stream, Bytes) :-
952 stream_property(Stream, position(Here)),
953 setup_call_cleanup(
954 open_null_stream(Out),
955 ( set_stream(Out, encoding(Enc)),
956 catch(copy_stream_data(Stream, Out), _, fail),
957 flush_output(Out),
958 byte_count(Out, Bytes)
959 ),
960 ( close(Out, [force(true)]),
961 set_stream_position(Stream, Here)
962 )).
963
964
965 968
1074
1075http_post_data(Data, Out, HdrExtra),
1076 http:post_data_hook(Data, Out, HdrExtra) =>
1077 true.
1078http_post_data(html(HTML), Out, HdrExtra) =>
1079 phrase(post_header(html(HTML), HdrExtra), Header),
1080 send_request_header(Out, Header),
1081 print_html(Out, HTML).
1082http_post_data(xml(XML), Out, HdrExtra) =>
1083 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
1084http_post_data(xml(Type, XML), Out, HdrExtra) =>
1085 http_post_data(xml(Type, XML, []), Out, HdrExtra).
1086http_post_data(xml(Type, XML, Options), Out, HdrExtra) =>
1087 setup_call_cleanup(
1088 new_memory_file(MemFile),
1089 ( setup_call_cleanup(
1090 open_memory_file(MemFile, write, MemOut),
1091 xml_write(MemOut, XML, Options),
1092 close(MemOut)),
1093 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
1094 ),
1095 free_memory_file(MemFile)).
1096http_post_data(file(File), Out, HdrExtra) =>
1097 ( file_mime_type(File, Type)
1098 -> true
1099 ; Type = text/plain
1100 ),
1101 http_post_data(file(Type, File), Out, HdrExtra).
1102http_post_data(file(Type, File), Out, HdrExtra) =>
1103 phrase(post_header(file(Type, File), HdrExtra), Header),
1104 send_request_header(Out, Header),
1105 setup_call_cleanup(
1106 open(File, read, In, [type(binary)]),
1107 copy_stream_data(In, Out),
1108 close(In)).
1109http_post_data(memory_file(Type, Handle), Out, HdrExtra) =>
1110 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1111 send_request_header(Out, Header),
1112 setup_call_cleanup(
1113 open_memory_file(Handle, read, In, [encoding(octet)]),
1114 copy_stream_data(In, Out),
1115 close(In)).
1116http_post_data(codes(Codes), Out, HdrExtra) =>
1117 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1118http_post_data(codes(Type, Codes), Out, HdrExtra) =>
1119 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1120 send_request_header(Out, Header),
1121 setup_call_cleanup(
1122 set_stream(Out, encoding(utf8)),
1123 format(Out, '~s', [Codes]),
1124 set_stream(Out, encoding(octet))).
1125http_post_data(bytes(Type, Bytes), Out, HdrExtra) =>
1126 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1127 send_request_header(Out, Header),
1128 format(Out, '~s', [Bytes]).
1129http_post_data(atom(Atom), Out, HdrExtra) =>
1130 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1131http_post_data(atom(Type, Atom), Out, HdrExtra) =>
1132 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1133 send_request_header(Out, Header),
1134 setup_call_cleanup(
1135 set_stream(Out, encoding(utf8)),
1136 write(Out, Atom),
1137 set_stream(Out, encoding(octet))).
1138http_post_data(string(String), Out, HdrExtra) =>
1139 http_post_data(atom(text/plain, String), Out, HdrExtra).
1140http_post_data(string(Type, String), Out, HdrExtra) =>
1141 phrase(post_header(string(Type, String), HdrExtra), Header),
1142 send_request_header(Out, Header),
1143 setup_call_cleanup(
1144 set_stream(Out, encoding(utf8)),
1145 write(Out, String),
1146 set_stream(Out, encoding(octet))).
1147http_post_data(cgi_stream(In, _Len), Out, HdrExtra) =>
1148 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1149 http_post_data(cgi_stream(In), Out, HdrExtra).
1150http_post_data(cgi_stream(In), Out, HdrExtra) =>
1151 http_read_header(In, Header0),
1152 http_update_encoding(Header0, Encoding, Header),
1153 content_length_in_encoding(Encoding, In, Size),
1154 http_join_headers(HdrExtra, Header, Hdr2),
1155 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1156 send_request_header(Out, HeaderText),
1157 setup_call_cleanup(
1158 set_stream(Out, encoding(Encoding)),
1159 copy_stream_data(In, Out),
1160 set_stream(Out, encoding(octet))).
1161http_post_data(form(Fields), Out, HdrExtra) =>
1162 parse_url_search(Codes, Fields),
1163 length(Codes, Size),
1164 http_join_headers(HdrExtra,
1165 [ content_type('application/x-www-form-urlencoded')
1166 ], Header),
1167 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1168 send_request_header(Out, HeaderChars),
1169 format(Out, '~s', [Codes]).
1170http_post_data(form_data(Data), Out, HdrExtra) =>
1171 setup_call_cleanup(
1172 new_memory_file(MemFile),
1173 ( setup_call_cleanup(
1174 open_memory_file(MemFile, write, MimeOut),
1175 mime_pack(Data, MimeOut, Boundary),
1176 close(MimeOut)),
1177 size_memory_file(MemFile, Size, octet),
1178 format(string(ContentType),
1179 'multipart/form-data; boundary=~w', [Boundary]),
1180 http_join_headers(HdrExtra,
1181 [ mime_version('1.0'),
1182 content_type(ContentType)
1183 ], Header),
1184 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1185 send_request_header(Out, HeaderChars),
1186 setup_call_cleanup(
1187 open_memory_file(MemFile, read, In, [encoding(octet)]),
1188 copy_stream_data(In, Out),
1189 close(In))
1190 ),
1191 free_memory_file(MemFile)).
1192http_post_data(List, Out, HdrExtra), is_list(List) => 1193 setup_call_cleanup(
1194 new_memory_file(MemFile),
1195 ( setup_call_cleanup(
1196 open_memory_file(MemFile, write, MimeOut),
1197 mime_pack(List, MimeOut, Boundary),
1198 close(MimeOut)),
1199 size_memory_file(MemFile, Size, octet),
1200 format(string(ContentType),
1201 'multipart/mixed; boundary=~w', [Boundary]),
1202 http_join_headers(HdrExtra,
1203 [ mime_version('1.0'),
1204 content_type(ContentType)
1205 ], Header),
1206 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1207 send_request_header(Out, HeaderChars),
1208 setup_call_cleanup(
1209 open_memory_file(MemFile, read, In, [encoding(octet)]),
1210 copy_stream_data(In, Out),
1211 close(In))
1212 ),
1213 free_memory_file(MemFile)).
1214
1219
(html(Tokens), HdrExtra) -->
1221 header_fields(HdrExtra, Len),
1222 content_length(html(Tokens), Len),
1223 content_type(text/html),
1224 "\r\n".
1225post_header(file(Type, File), HdrExtra) -->
1226 header_fields(HdrExtra, Len),
1227 content_length(file(File), Len),
1228 content_type(Type),
1229 "\r\n".
1230post_header(memory_file(Type, File), HdrExtra) -->
1231 header_fields(HdrExtra, Len),
1232 content_length(memory_file(File), Len),
1233 content_type(Type),
1234 "\r\n".
1235post_header(cgi_data(Size), HdrExtra) -->
1236 header_fields(HdrExtra, Len),
1237 content_length(Size, Len),
1238 "\r\n".
1239post_header(codes(Type, Codes), HdrExtra) -->
1240 header_fields(HdrExtra, Len),
1241 content_length(codes(Codes, utf8), Len),
1242 content_type(Type, utf8),
1243 "\r\n".
1244post_header(bytes(Type, Bytes), HdrExtra) -->
1245 header_fields(HdrExtra, Len),
1246 content_length(bytes(Bytes), Len),
1247 content_type(Type),
1248 "\r\n".
1249post_header(atom(Type, Atom), HdrExtra) -->
1250 header_fields(HdrExtra, Len),
1251 content_length(atom(Atom, utf8), Len),
1252 content_type(Type, utf8),
1253 "\r\n".
1254post_header(string(Type, String), HdrExtra) -->
1255 header_fields(HdrExtra, Len),
1256 content_length(string(String, utf8), Len),
1257 content_type(Type, utf8),
1258 "\r\n".
1259
1260
1261 1264
1269
(Out, What, HdrExtra) :-
1271 phrase(reply_header(What, HdrExtra, _Code), String),
1272 !,
1273 send_reply_header(Out, String).
1274
1296
(Data, Dict) -->
1298 { _{header:HdrExtra, code:Code} :< Dict },
1299 reply_header(Data, HdrExtra, Code).
1300
(string(String), HdrExtra, Code) -->
1302 reply_header(string(text/plain, String), HdrExtra, Code).
1303reply_header(string(Type, String), HdrExtra, Code) -->
1304 vstatus(ok, Code, HdrExtra),
1305 date(now),
1306 header_fields(HdrExtra, CLen),
1307 content_length(codes(String, utf8), CLen),
1308 content_type(Type, utf8),
1309 "\r\n".
1310reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
1311 vstatus(ok, Code, HdrExtra),
1312 date(now),
1313 header_fields(HdrExtra, CLen),
1314 content_length(bytes(Bytes), CLen),
1315 content_type(Type),
1316 "\r\n".
1317reply_header(html(Tokens), HdrExtra, Code) -->
1318 vstatus(ok, Code, HdrExtra),
1319 date(now),
1320 header_fields(HdrExtra, CLen),
1321 content_length(html(Tokens, utf8), CLen),
1322 content_type(text/html, utf8),
1323 "\r\n".
1324reply_header(file(Type, File), HdrExtra, Code) -->
1325 vstatus(ok, Code, HdrExtra),
1326 date(now),
1327 modified(file(File)),
1328 header_fields(HdrExtra, CLen),
1329 content_length(file(File), CLen),
1330 content_type(Type),
1331 "\r\n".
1332reply_header(gzip_file(Type, File), HdrExtra, Code) -->
1333 vstatus(ok, Code, HdrExtra),
1334 date(now),
1335 modified(file(File)),
1336 header_fields(HdrExtra, CLen),
1337 content_length(file(File), CLen),
1338 content_type(Type),
1339 content_encoding(gzip),
1340 "\r\n".
1341reply_header(file(Type, File, Range), HdrExtra, Code) -->
1342 vstatus(partial_content, Code, HdrExtra),
1343 date(now),
1344 modified(file(File)),
1345 header_fields(HdrExtra, CLen),
1346 content_length(file(File, Range), CLen),
1347 content_type(Type),
1348 "\r\n".
1349reply_header(tmp_file(Type, File), HdrExtra, Code) -->
1350 vstatus(ok, Code, HdrExtra),
1351 date(now),
1352 header_fields(HdrExtra, CLen),
1353 content_length(file(File), CLen),
1354 content_type(Type),
1355 "\r\n".
1356reply_header(cgi_data(Size), HdrExtra, Code) -->
1357 vstatus(ok, Code, HdrExtra),
1358 date(now),
1359 header_fields(HdrExtra, CLen),
1360 content_length(Size, CLen),
1361 "\r\n".
1362reply_header(event_stream, HdrExtra, Code) -->
1363 vstatus(ok, Code, HdrExtra),
1364 date(now),
1365 header_fields(HdrExtra, _),
1366 "\r\n".
1367reply_header(chunked_data, HdrExtra, Code) -->
1368 vstatus(ok, Code, HdrExtra),
1369 date(now),
1370 header_fields(HdrExtra, _),
1371 ( {memberchk(transfer_encoding(_), HdrExtra)}
1372 -> ""
1373 ; transfer_encoding(chunked)
1374 ),
1375 "\r\n".
1377reply_header(status(Status), HdrExtra, Code) -->
1378 vstatus(Status, Code),
1379 header_fields(HdrExtra, Clen),
1380 { Clen = 0 },
1381 "\r\n".
1383reply_header(Data, HdrExtra, Code) -->
1384 { status_reply_headers(Data,
1385 body(Type, Encoding, Content),
1386 ReplyHeaders),
1387 http_join_headers(ReplyHeaders, HdrExtra, Headers),
1388 functor(Data, CodeName, _)
1389 },
1390 vstatus(CodeName, Code, Headers),
1391 date(now),
1392 header_fields(Headers, CLen),
1393 content_length(codes(Content, Encoding), CLen),
1394 content_type(Type, Encoding),
1395 "\r\n".
1396
(created(Location, Body), Body,
1398 [ location(Location) ]).
1399status_reply_headers(moved(To, Body), Body,
1400 [ location(To) ]).
1401status_reply_headers(moved_temporary(To, Body), Body,
1402 [ location(To) ]).
1403status_reply_headers(gone(_URL, Body), Body, []).
1404status_reply_headers(see_other(To, Body), Body,
1405 [ location(To) ]).
1406status_reply_headers(authorise(Method, Body), Body,
1407 [ www_authenticate(Method) ]).
1408status_reply_headers(not_found(_URL, Body), Body, []).
1409status_reply_headers(forbidden(_URL, Body), Body, []).
1410status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
1411status_reply_headers(server_error(_Error, Body), Body, []).
1412status_reply_headers(service_unavailable(_Why, Body), Body, []).
1413status_reply_headers(not_acceptable(_Why, Body), Body, []).
1414status_reply_headers(bad_request(_Error, Body), Body, []).
1415
1416
1421
1422vstatus(_Status, Code, HdrExtra) -->
1423 {memberchk(status(Code), HdrExtra)},
1424 !,
1425 vstatus(_NewStatus, Code).
1426vstatus(Status, Code, _) -->
1427 vstatus(Status, Code).
1428
1429vstatus(Status, Code) -->
1430 "HTTP/1.1 ",
1431 status_number(Status, Code),
1432 " ",
1433 status_comment(Status),
1434 "\r\n".
1435
1442
1443status_number(Status, Code) -->
1444 { var(Status) },
1445 !,
1446 integer(Code),
1447 { status_number(Status, Code) },
1448 !.
1449status_number(Status, Code) -->
1450 { status_number(Status, Code) },
1451 integer(Code).
1452
1464
1472
1473status_number(Status, Code) :-
1474 nonvar(Status),
1475 !,
1476 status_number_fact(Status, Code).
1477status_number(Status, Code) :-
1478 nonvar(Code),
1479 !,
1480 ( between(100, 599, Code)
1481 -> ( status_number_fact(Status, Code)
1482 -> true
1483 ; ClassCode is Code // 100 * 100,
1484 status_number_fact(Status, ClassCode)
1485 )
1486 ; domain_error(http_code, Code)
1487 ).
1488
1489status_number_fact(continue, 100).
1490status_number_fact(switching_protocols, 101).
1491status_number_fact(ok, 200).
1492status_number_fact(created, 201).
1493status_number_fact(accepted, 202).
1494status_number_fact(non_authoritative_info, 203).
1495status_number_fact(no_content, 204).
1496status_number_fact(reset_content, 205).
1497status_number_fact(partial_content, 206).
1498status_number_fact(multiple_choices, 300).
1499status_number_fact(moved, 301).
1500status_number_fact(moved_temporary, 302).
1501status_number_fact(see_other, 303).
1502status_number_fact(not_modified, 304).
1503status_number_fact(use_proxy, 305).
1504status_number_fact(unused, 306).
1505status_number_fact(temporary_redirect, 307).
1506status_number_fact(bad_request, 400).
1507status_number_fact(authorise, 401).
1508status_number_fact(payment_required, 402).
1509status_number_fact(forbidden, 403).
1510status_number_fact(not_found, 404).
1511status_number_fact(method_not_allowed, 405).
1512status_number_fact(not_acceptable, 406).
1513status_number_fact(request_timeout, 408).
1514status_number_fact(conflict, 409).
1515status_number_fact(gone, 410).
1516status_number_fact(length_required, 411).
1517status_number_fact(payload_too_large, 413).
1518status_number_fact(uri_too_long, 414).
1519status_number_fact(unsupported_media_type, 415).
1520status_number_fact(expectation_failed, 417).
1521status_number_fact(upgrade_required, 426).
1522status_number_fact(server_error, 500).
1523status_number_fact(not_implemented, 501).
1524status_number_fact(bad_gateway, 502).
1525status_number_fact(service_unavailable, 503).
1526status_number_fact(gateway_timeout, 504).
1527status_number_fact(http_version_not_supported, 505).
1528
1529
1533
(continue) -->
1535 "Continue".
1536status_comment(switching_protocols) -->
1537 "Switching Protocols".
1538status_comment(ok) -->
1539 "OK".
1540status_comment(created) -->
1541 "Created".
1542status_comment(accepted) -->
1543 "Accepted".
1544status_comment(non_authoritative_info) -->
1545 "Non-Authoritative Information".
1546status_comment(no_content) -->
1547 "No Content".
1548status_comment(reset_content) -->
1549 "Reset Content".
1550status_comment(created) -->
1551 "Created".
1552status_comment(partial_content) -->
1553 "Partial content".
1554status_comment(multiple_choices) -->
1555 "Multiple Choices".
1556status_comment(moved) -->
1557 "Moved Permanently".
1558status_comment(moved_temporary) -->
1559 "Moved Temporary".
1560status_comment(see_other) -->
1561 "See Other".
1562status_comment(not_modified) -->
1563 "Not Modified".
1564status_comment(use_proxy) -->
1565 "Use Proxy".
1566status_comment(unused) -->
1567 "Unused".
1568status_comment(temporary_redirect) -->
1569 "Temporary Redirect".
1570status_comment(bad_request) -->
1571 "Bad Request".
1572status_comment(authorise) -->
1573 "Authorization Required".
1574status_comment(payment_required) -->
1575 "Payment Required".
1576status_comment(forbidden) -->
1577 "Forbidden".
1578status_comment(not_found) -->
1579 "Not Found".
1580status_comment(method_not_allowed) -->
1581 "Method Not Allowed".
1582status_comment(not_acceptable) -->
1583 "Not Acceptable".
1584status_comment(request_timeout) -->
1585 "Request Timeout".
1586status_comment(conflict) -->
1587 "Conflict".
1588status_comment(gone) -->
1589 "Gone".
1590status_comment(length_required) -->
1591 "Length Required".
1592status_comment(payload_too_large) -->
1593 "Payload Too Large".
1594status_comment(uri_too_long) -->
1595 "URI Too Long".
1596status_comment(unsupported_media_type) -->
1597 "Unsupported Media Type".
1598status_comment(expectation_failed) -->
1599 "Expectation Failed".
1600status_comment(upgrade_required) -->
1601 "Upgrade Required".
1602status_comment(server_error) -->
1603 "Internal Server Error".
1604status_comment(not_implemented) -->
1605 "Not Implemented".
1606status_comment(bad_gateway) -->
1607 "Bad Gateway".
1608status_comment(service_unavailable) -->
1609 "Service Unavailable".
1610status_comment(gateway_timeout) -->
1611 "Gateway Timeout".
1612status_comment(http_version_not_supported) -->
1613 "HTTP Version Not Supported".
1614
1615date(Time) -->
1616 "Date: ",
1617 ( { Time == now }
1618 -> now
1619 ; rfc_date(Time)
1620 ),
1621 "\r\n".
1622
1623modified(file(File)) -->
1624 !,
1625 { time_file(File, Time)
1626 },
1627 modified(Time).
1628modified(Time) -->
1629 "Last-modified: ",
1630 ( { Time == now }
1631 -> now
1632 ; rfc_date(Time)
1633 ),
1634 "\r\n".
1635
1636
1643
1644content_length(file(File, bytes(From, To)), Len) -->
1645 !,
1646 { size_file(File, Size),
1647 ( To == end
1648 -> Len is Size - From,
1649 RangeEnd is Size - 1
1650 ; Len is To+1 - From, 1651 RangeEnd = To
1652 )
1653 },
1654 content_range(bytes, From, RangeEnd, Size),
1655 content_length(Len, Len).
1656content_length(Reply, Len) -->
1657 { length_of(Reply, Len)
1658 },
1659 "Content-Length: ", integer(Len),
1660 "\r\n".
1661
1662:- meta_predicate
1663 print_length(0, -, +, -). 1664
1665:- det(length_of/2). 1666length_of(_, Len), integer(Len) => true.
1667length_of(string(String, Encoding), Len) =>
1668 length_of(codes(String, Encoding), Len).
1669length_of(codes(String, Encoding), Len) =>
1670 print_length(format(Out, '~s', [String]), Out, Encoding, Len).
1671length_of(atom(Atom, Encoding), Len) =>
1672 print_length(format(Out, '~a', [Atom]), Out, Encoding, Len).
1673length_of(file(File), Len) =>
1674 size_file(File, Len).
1675length_of(memory_file(Handle), Len) =>
1676 size_memory_file(Handle, Len, octet).
1677length_of(html_tokens(Tokens), Len) =>
1678 html_print_length(Tokens, Len).
1679length_of(html(Tokens, Encoding), Len) =>
1680 print_length(print_html(Out, Tokens), Out, Encoding, Len).
1681length_of(bytes(Bytes), Len) =>
1682 print_length(format(Out, '~s', [Bytes]), Out, octet, Len).
1683length_of(Num, Len), integer(Num) =>
1684 Len = Num.
1685
1686print_length(Goal, Out, Encoding, Len) :-
1687 setup_call_cleanup(
1688 open_null_stream(Out),
1689 ( set_stream(Out, encoding(Encoding)),
1690 call(Goal),
1691 byte_count(Out, Len)
1692 ),
1693 close(Out)).
1694
1699
1700content_range(Unit, From, RangeEnd, Size) -->
1701 "Content-Range: ", atom(Unit), " ",
1702 integer(From), "-", integer(RangeEnd), "/", integer(Size),
1703 "\r\n".
1704
1705content_encoding(Encoding) -->
1706 "Content-Encoding: ", atom(Encoding), "\r\n".
1707
1708transfer_encoding(Encoding) -->
1709 "Transfer-Encoding: ", atom(Encoding), "\r\n".
1710
1711content_type(Type) -->
1712 content_type(Type, _).
1713
1714content_type(Type, Charset) -->
1715 ctype(Type),
1716 charset(Charset),
1717 "\r\n".
1718
1719ctype(Main/Sub) -->
1720 !,
1721 "Content-Type: ",
1722 atom(Main),
1723 "/",
1724 atom(Sub).
1725ctype(Type) -->
1726 !,
1727 "Content-Type: ",
1728 atom(Type).
1729
1730charset(Var) -->
1731 { var(Var) },
1732 !.
1733charset(utf8) -->
1734 !,
1735 "; charset=UTF-8".
1736charset(CharSet) -->
1737 "; charset=",
1738 atom(CharSet).
1739
1745
(Name, Value) -->
1747 { var(Name) }, 1748 !,
1749 field_name(Name),
1750 ":",
1751 whites,
1752 read_field_value(ValueChars),
1753 blanks_to_nl,
1754 !,
1755 { field_to_prolog(Name, ValueChars, Value)
1756 -> true
1757 ; atom_codes(Value, ValueChars),
1758 domain_error(Name, Value)
1759 }.
1760header_field(Name, Value) -->
1761 field_name(Name),
1762 ": ",
1763 field_value(Name, Value),
1764 "\r\n".
1765
1769
1770read_field_value([H|T]) -->
1771 [H],
1772 { \+ code_type(H, space) },
1773 !,
1774 read_field_value(T).
1775read_field_value([]) -->
1776 "".
1777read_field_value([H|T]) -->
1778 [H],
1779 read_field_value(T).
1780
1785
(Out, String) :-
1787 debug(http(send_reply), "< ~s", [String]),
1788 format(Out, '~s', [String]).
1789
(Out, String) :-
1791 debug(http(send_request), "> ~s", [String]),
1792 format(Out, '~s', [String]).
1793
1833
(Field, Value, Prolog) :-
1835 known_field(Field, _, Type),
1836 ( already_parsed(Type, Value)
1837 -> Prolog = Value
1838 ; parse_header_value_atom(Field, Value, Prolog)
1839 -> true
1840 ; to_codes(Value, Codes),
1841 parse_header_value(Field, Codes, Prolog)
1842 ).
1843
1844already_parsed(integer, V) :- !, integer(V).
1845already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
1846already_parsed(Term, V) :- subsumes_term(Term, V).
1847
1848
1853
1854known_field(content_length, true, integer).
1855known_field(status, true, integer).
1856known_field(expires, false, number).
1857known_field(cookie, true, list(_=_)).
1858known_field(set_cookie, true, list(set_cookie(_Name,_Value,_Options))).
1859known_field(host, true, _Host:_Port).
1860known_field(range, maybe, bytes(_,_)).
1861known_field(accept, maybe, list(media(_Type, _Parms, _Q, _Exts))).
1862known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
1863known_field(content_type, false, media(_Type/_Sub, _Attributes)).
1864
1865to_codes(In, Codes) :-
1866 ( is_list(In)
1867 -> Codes = In
1868 ; atom_codes(In, Codes)
1869 ).
1870
1876
1877field_to_prolog(Field, Codes, Prolog) :-
1878 known_field(Field, true, _Type),
1879 !,
1880 ( parse_header_value(Field, Codes, Prolog0)
1881 -> Prolog = Prolog0
1882 ).
1883field_to_prolog(Field, Codes, Prolog) :-
1884 known_field(Field, maybe, _Type),
1885 parse_header_value(Field, Codes, Prolog0),
1886 !,
1887 Prolog = Prolog0.
1888field_to_prolog(_, Codes, Atom) :-
1889 atom_codes(Atom, Codes).
1890
1894
(content_length, Atom, ContentLength) :-
1896 atomic(Atom),
1897 atom_number(Atom, ContentLength).
1898parse_header_value_atom(expires, Atom, Stamp) :-
1899 http_timestamp(Stamp, Atom).
1900
1905
(content_length, ValueChars, ContentLength) :-
1907 number_codes(ContentLength, ValueChars).
1908parse_header_value(expires, ValueCodes, Stamp) :-
1909 http_timestamp(Stamp, ValueCodes).
1910parse_header_value(status, ValueChars, Code) :-
1911 ( phrase(" ", L, _),
1912 append(Pre, L, ValueChars)
1913 -> number_codes(Code, Pre)
1914 ; number_codes(Code, ValueChars)
1915 ).
1916parse_header_value(cookie, ValueChars, Cookies) :-
1917 debug(cookie, 'Cookie: ~s', [ValueChars]),
1918 phrase(cookies(Cookies), ValueChars).
1919parse_header_value(set_cookie, ValueChars, SetCookie) :-
1920 debug(cookie, 'SetCookie: ~s', [ValueChars]),
1921 phrase(set_cookie(SetCookie), ValueChars).
1922parse_header_value(host, ValueChars, Host) :-
1923 ( append(HostChars, [0':|PortChars], ValueChars),
1924 catch(number_codes(Port, PortChars), _, fail)
1925 -> atom_codes(HostName, HostChars),
1926 Host = HostName:Port
1927 ; atom_codes(Host, ValueChars)
1928 ).
1929parse_header_value(range, ValueChars, Range) :-
1930 phrase(range(Range), ValueChars).
1931parse_header_value(accept, ValueChars, Media) :-
1932 parse_accept(ValueChars, Media).
1933parse_header_value(content_disposition, ValueChars, Disposition) :-
1934 phrase(content_disposition(Disposition), ValueChars).
1935parse_header_value(content_type, ValueChars, Type) :-
1936 phrase(parse_content_type(Type), ValueChars).
1937
1939
1940field_value(_, set_cookie(Name, Value, Options)) -->
1941 !,
1942 atom(Name), "=", atom(Value),
1943 value_options(Options, cookie).
1944field_value(_, disposition(Disposition, Options)) -->
1945 !,
1946 atom(Disposition), value_options(Options, disposition).
1947field_value(www_authenticate, Auth) -->
1948 auth_field_value(Auth).
1949field_value(_, Atomic) -->
1950 atom(Atomic).
1951
1955
1956auth_field_value(negotiate(Data)) -->
1957 "Negotiate ",
1958 { base64(Data, DataBase64),
1959 atom_codes(DataBase64, Codes)
1960 },
1961 string(Codes).
1962auth_field_value(negotiate) -->
1963 "Negotiate".
1964auth_field_value(basic) -->
1965 !,
1966 "Basic".
1967auth_field_value(basic(Realm)) -->
1968 "Basic Realm=\"", atom(Realm), "\"".
1969auth_field_value(digest) -->
1970 !,
1971 "Digest".
1972auth_field_value(digest(Details)) -->
1973 "Digest ", atom(Details).
1974
1981
1982value_options([], _) --> [].
1983value_options([H|T], Field) -->
1984 "; ", value_option(H, Field),
1985 value_options(T, Field).
1986
1987value_option(secure=true, cookie) -->
1988 !,
1989 "secure".
1990value_option(Name=Value, Type) -->
1991 { string_option(Name, Type) },
1992 !,
1993 atom(Name), "=",
1994 qstring(Value).
1995value_option(Name=Value, Type) -->
1996 { token_option(Name, Type) },
1997 !,
1998 atom(Name), "=", atom(Value).
1999value_option(Name=Value, _Type) -->
2000 atom(Name), "=",
2001 option_value(Value).
2002
2003string_option(filename, disposition).
2004
2005token_option(path, cookie).
2006
2007option_value(Value) -->
2008 { number(Value) },
2009 !,
2010 number(Value).
2011option_value(Value) -->
2012 { ( atom(Value)
2013 -> true
2014 ; string(Value)
2015 ),
2016 forall(string_code(_, Value, C),
2017 token_char(C))
2018 },
2019 !,
2020 atom(Value).
2021option_value(Atomic) -->
2022 qstring(Atomic).
2023
2024qstring(Atomic) -->
2025 { string_codes(Atomic, Codes) },
2026 "\"",
2027 qstring_codes(Codes),
2028 "\"".
2029
2030qstring_codes([]) --> [].
2031qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
2032
2033qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
2034qstring_code(C) --> [C].
2035
2036qstring_esc(0'").
2037qstring_esc(C) :- ctl(C).
2038
2039
2040 2043
2044:- dynamic accept_cache/2. 2045:- volatile accept_cache/2. 2046
2047parse_accept(Codes, Media) :-
2048 atom_codes(Atom, Codes),
2049 ( accept_cache(Atom, Media0)
2050 -> Media = Media0
2051 ; phrase(accept(Media0), Codes),
2052 keysort(Media0, Media1),
2053 pairs_values(Media1, Media2),
2054 assertz(accept_cache(Atom, Media2)),
2055 Media = Media2
2056 ).
2057
2061
2062accept([H|T]) -->
2063 blanks,
2064 media_range(H),
2065 blanks,
2066 ( ","
2067 -> accept(T)
2068 ; {T=[]}
2069 ).
2070
2071media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
2072 media_type(Type),
2073 blanks,
2074 ( ";"
2075 -> blanks,
2076 parameters_and_quality(TypeParams, Quality, AcceptExts)
2077 ; { TypeParams = [],
2078 Quality = 1.0,
2079 AcceptExts = []
2080 }
2081 ),
2082 { SortQuality is float(-Quality),
2083 rank_specialised(Type, TypeParams, Spec)
2084 }.
2085
2086
2090
2091content_disposition(disposition(Disposition, Options)) -->
2092 token(Disposition), blanks,
2093 value_parameters(Options).
2094
2099
2100parse_content_type(media(Type, Parameters)) -->
2101 media_type(Type), blanks,
2102 value_parameters(Parameters).
2103
2104
2112
2113rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
2114 var_or_given(Type, VT),
2115 var_or_given(SubType, VS),
2116 length(TypeParams, VP),
2117 SortVP is -VP.
2118
2119var_or_given(V, Val) :-
2120 ( var(V)
2121 -> Val = 0
2122 ; Val = -1
2123 ).
2124
2125media_type(Type/SubType) -->
2126 type(Type), "/", type(SubType).
2127
2128type(_) -->
2129 "*",
2130 !.
2131type(Type) -->
2132 token(Type).
2133
2134parameters_and_quality(Params, Quality, AcceptExts) -->
2135 token(Name),
2136 blanks, "=", blanks,
2137 ( { Name == q }
2138 -> float(Quality), blanks,
2139 value_parameters(AcceptExts),
2140 { Params = [] }
2141 ; { Params = [Name=Value|T] },
2142 parameter_value(Value),
2143 blanks,
2144 ( ";"
2145 -> blanks,
2146 parameters_and_quality(T, Quality, AcceptExts)
2147 ; { T = [],
2148 Quality = 1.0,
2149 AcceptExts = []
2150 }
2151 )
2152 ).
2153
2158
2159value_parameters([H|T]) -->
2160 ";",
2161 !,
2162 blanks, token(Name), blanks,
2163 ( "="
2164 -> blanks,
2165 ( token(Value)
2166 -> []
2167 ; quoted_string(Value)
2168 ),
2169 { H = (Name=Value) }
2170 ; { H = Name }
2171 ),
2172 blanks,
2173 value_parameters(T).
2174value_parameters([]) -->
2175 [].
2176
2177parameter_value(Value) --> token(Value), !.
2178parameter_value(Value) --> quoted_string(Value).
2179
2180
2184
2185token(Name) -->
2186 token_char(C1),
2187 token_chars(Cs),
2188 { atom_codes(Name, [C1|Cs]) }.
2189
2190token_chars([H|T]) -->
2191 token_char(H),
2192 !,
2193 token_chars(T).
2194token_chars([]) --> [].
2195
2196token_char(C) :-
2197 \+ ctl(C),
2198 \+ separator_code(C).
2199
2200ctl(C) :- between(0,31,C), !.
2201ctl(127).
2202
2203separator_code(0'().
2204separator_code(0')).
2205separator_code(0'<).
2206separator_code(0'>).
2207separator_code(0'@).
2208separator_code(0',).
2209separator_code(0';).
2210separator_code(0':).
2211separator_code(0'\\).
2212separator_code(0'").
2213separator_code(0'/).
2214separator_code(0'[).
2215separator_code(0']).
2216separator_code(0'?).
2217separator_code(0'=).
2218separator_code(0'{).
2219separator_code(0'}).
2220separator_code(0'\s).
2221separator_code(0'\t).
2222
2223term_expansion(token_char(x) --> [x], Clauses) :-
2224 findall((token_char(C)-->[C]),
2225 ( between(0, 255, C),
2226 token_char(C)
2227 ),
2228 Clauses).
2229
2230token_char(x) --> [x].
2231
2235
2236quoted_string(Text) -->
2237 "\"",
2238 quoted_text(Codes),
2239 { atom_codes(Text, Codes) }.
2240
2241quoted_text([]) -->
2242 "\"",
2243 !.
2244quoted_text([H|T]) -->
2245 "\\", !, [H],
2246 quoted_text(T).
2247quoted_text([H|T]) -->
2248 [H],
2249 !,
2250 quoted_text(T).
2251
2252
2260
([], _) --> [].
2262header_fields([content_length(CLen)|T], CLen) -->
2263 !,
2264 ( { var(CLen) }
2265 -> ""
2266 ; header_field(content_length, CLen)
2267 ),
2268 header_fields(T, CLen). 2269header_fields([status(_)|T], CLen) --> 2270 !,
2271 header_fields(T, CLen).
2272header_fields([H|T], CLen) -->
2273 { H =.. [Name, Value] },
2274 header_field(Name, Value),
2275 header_fields(T, CLen).
2276
2277
2291
2292:- public
2293 field_name//1. 2294
2295field_name(Name) -->
2296 { var(Name) },
2297 !,
2298 rd_field_chars(Chars),
2299 { atom_codes(Name, Chars) }.
2300field_name(mime_version) -->
2301 !,
2302 "MIME-Version".
2303field_name(www_authenticate) -->
2304 !,
2305 "WWW-Authenticate".
2306field_name(Name) -->
2307 { atom_codes(Name, Chars) },
2308 wr_field_chars(Chars).
2309
2310rd_field_chars_no_fold([C|T]) -->
2311 [C],
2312 { rd_field_char(C, _) },
2313 !,
2314 rd_field_chars_no_fold(T).
2315rd_field_chars_no_fold([]) -->
2316 [].
2317
2318rd_field_chars([C0|T]) -->
2319 [C],
2320 { rd_field_char(C, C0) },
2321 !,
2322 rd_field_chars(T).
2323rd_field_chars([]) -->
2324 [].
2325
2329
2330separators("()<>@,;:\\\"/[]?={} \t").
2331
2332term_expansion(rd_field_char('expand me',_), Clauses) :-
2333
2334 Clauses = [ rd_field_char(0'-, 0'_)
2335 | Cls
2336 ],
2337 separators(SepString),
2338 string_codes(SepString, Seps),
2339 findall(rd_field_char(In, Out),
2340 ( between(32, 127, In),
2341 \+ memberchk(In, Seps),
2342 In \== 0'-, 2343 code_type(Out, to_lower(In))),
2344 Cls).
2345
2346rd_field_char('expand me', _). 2347
2348wr_field_chars([C|T]) -->
2349 !,
2350 { code_type(C, to_lower(U)) },
2351 [U],
2352 wr_field_chars2(T).
2353wr_field_chars([]) -->
2354 [].
2355
2356wr_field_chars2([]) --> [].
2357wr_field_chars2([C|T]) --> 2358 ( { C == 0'_ }
2359 -> "-",
2360 wr_field_chars(T)
2361 ; [C],
2362 wr_field_chars2(T)
2363 ).
2364
2368
2369now -->
2370 { get_time(Time)
2371 },
2372 rfc_date(Time).
2373
2378
2379rfc_date(Time, String, Tail) :-
2380 stamp_date_time(Time, Date, 'UTC'),
2381 format_time(codes(String, Tail),
2382 '%a, %d %b %Y %T GMT',
2383 Date, posix).
2384
2393
2394http_timestamp(Time, Text), nonvar(Text) =>
2395 ( parse_time(Text, _Format, Time0)
2396 -> ( var(Time)
2397 -> Time = Time0
2398 ; Time =:= Time0
2399 )
2400 ; syntax_error(http_timestamp(Text))
2401 ).
2402http_timestamp(Time, Atom), number(Time) =>
2403 stamp_date_time(Time, Date, 'UTC'),
2404 format_time(atom(Atom),
2405 '%a, %d %b %Y %T GMT',
2406 Date, posix).
2407
2408
2409 2412
2413request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
2414 method(Method),
2415 blanks,
2416 nonblanks(Query),
2417 { atom_codes(ReqURI, Query),
2418 request_uri_parts(ReqURI, Header, Rest)
2419 },
2420 request_header(Fd, Rest),
2421 !.
2422request(Fd, [unknown(What)|Header]) -->
2423 string(What),
2424 eos,
2425 !,
2426 { http_read_header(Fd, Header)
2427 -> true
2428 ; Header = []
2429 }.
2430
2431method(get) --> "GET", !.
2432method(put) --> "PUT", !.
2433method(head) --> "HEAD", !.
2434method(post) --> "POST", !.
2435method(delete) --> "DELETE", !.
2436method(patch) --> "PATCH", !.
2437method(options) --> "OPTIONS", !.
2438method(trace) --> "TRACE", !.
2439
2451
2452request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
2453 uri_components(ReqURI, Components),
2454 uri_data(path, Components, PathText),
2455 uri_encoded(path, Path, PathText),
2456 phrase(uri_parts(Components), Parts, Rest).
2457
2458uri_parts(Components) -->
2459 uri_search(Components),
2460 uri_fragment(Components).
2461
2462uri_search(Components) -->
2463 { uri_data(search, Components, Search),
2464 nonvar(Search),
2465 catch(uri_query_components(Search, Query),
2466 error(syntax_error(_),_),
2467 fail)
2468 },
2469 !,
2470 [ search(Query) ].
2471uri_search(_) --> [].
2472
2473uri_fragment(Components) -->
2474 { uri_data(fragment, Components, String),
2475 nonvar(String),
2476 !,
2477 uri_encoded(fragment, Fragment, String)
2478 },
2479 [ fragment(Fragment) ].
2480uri_fragment(_) --> [].
2481
2486
(_, []) --> 2488 blanks,
2489 eos,
2490 !.
2491request_header(Fd, [http_version(Version)|Header]) -->
2492 http_version(Version),
2493 blanks,
2494 eos,
2495 !,
2496 { Version = 1-_
2497 -> http_read_header(Fd, Header)
2498 ; Header = []
2499 }.
2500
2501http_version(Version) -->
2502 blanks,
2503 "HTTP/",
2504 http_version_number(Version).
2505
2506http_version_number(Major-Minor) -->
2507 integer(Major),
2508 ".",
2509 integer(Minor).
2510
2511
2512 2515
2519
2520cookies([Name=Value|T]) -->
2521 blanks,
2522 cookie(Name, Value),
2523 !,
2524 blanks,
2525 ( ";"
2526 -> cookies(T)
2527 ; { T = [] }
2528 ).
2529cookies(List) -->
2530 string(Skipped),
2531 ";",
2532 !,
2533 { print_message(warning, http(skipped_cookie(Skipped))) },
2534 cookies(List).
2535cookies([]) -->
2536 blanks.
2537
2538cookie(Name, Value) -->
2539 cookie_name(Name),
2540 blanks, "=", blanks,
2541 cookie_value(Value).
2542
2543cookie_name(Name) -->
2544 { var(Name) },
2545 !,
2546 rd_field_chars_no_fold(Chars),
2547 { atom_codes(Name, Chars) }.
2548
2549cookie_value(Value) -->
2550 quoted_string(Value),
2551 !.
2552cookie_value(Value) -->
2553 chars_to_semicolon_or_blank(Chars),
2554 { atom_codes(Value, Chars)
2555 }.
2556
2557chars_to_semicolon_or_blank([]), ";" -->
2558 ";",
2559 !.
2560chars_to_semicolon_or_blank([]) -->
2561 " ",
2562 blanks,
2563 eos,
2564 !.
2565chars_to_semicolon_or_blank([H|T]) -->
2566 [H],
2567 !,
2568 chars_to_semicolon_or_blank(T).
2569chars_to_semicolon_or_blank([]) -->
2570 [].
2571
2572set_cookie(set_cookie(Name, Value, Options)) -->
2573 ws,
2574 cookie(Name, Value),
2575 cookie_options(Options).
2576
2577cookie_options([H|T]) -->
2578 ws,
2579 ";",
2580 ws,
2581 cookie_option(H),
2582 !,
2583 cookie_options(T).
2584cookie_options([]) -->
2585 ws.
2586
2587ws --> " ", !, ws.
2588ws --> [].
2589
2590
2599
2600cookie_option(Name=Value) -->
2601 rd_field_chars(NameChars), ws,
2602 { atom_codes(Name, NameChars) },
2603 ( "="
2604 -> ws,
2605 chars_to_semicolon(ValueChars),
2606 { atom_codes(Value, ValueChars)
2607 }
2608 ; { Value = true }
2609 ).
2610
2611chars_to_semicolon([H|T]) -->
2612 [H],
2613 { H \== 32, H \== 0'; },
2614 !,
2615 chars_to_semicolon(T).
2616chars_to_semicolon([]), ";" -->
2617 ws, ";",
2618 !.
2619chars_to_semicolon([H|T]) -->
2620 [H],
2621 chars_to_semicolon(T).
2622chars_to_semicolon([]) -->
2623 [].
2624
2632
2633range(bytes(From, To)) -->
2634 "bytes", whites, "=", whites, integer(From), "-",
2635 ( integer(To)
2636 -> ""
2637 ; { To = end }
2638 ).
2639
2640
2641 2644
2659
2660reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
2661 http_version(HttpVersion),
2662 blanks,
2663 ( status_number(Status, Code)
2664 -> []
2665 ; integer(Status)
2666 ),
2667 blanks,
2668 string(CommentCodes),
2669 blanks_to_nl,
2670 !,
2671 blanks,
2672 { atom_codes(Comment, CommentCodes),
2673 http_read_header(Fd, Header)
2674 }.
2675
2676
2677 2680
2686
(Fd, Header) :-
2688 read_header_data(Fd, Text),
2689 http_parse_header(Text, Header).
2690
(Fd, Header) :-
2692 read_line_to_codes(Fd, Header, Tail),
2693 read_header_data(Header, Fd, Tail),
2694 debug(http(header), 'Header = ~n~s~n', [Header]).
2695
([0'\r,0'\n], _, _) :- !.
2697read_header_data([0'\n], _, _) :- !.
2698read_header_data([], _, _) :- !.
2699read_header_data(_, Fd, Tail) :-
2700 read_line_to_codes(Fd, Tail, NewTail),
2701 read_header_data(Tail, Fd, NewTail).
2702
2709
(Text, Header) :-
2711 phrase(header(Header), Text),
2712 debug(http(header), 'Field: ~p', [Header]).
2713
(List) -->
2715 header_field(Name, Value),
2716 !,
2717 { mkfield(Name, Value, List, Tail)
2718 },
2719 blanks,
2720 header(Tail).
2721header([]) -->
2722 blanks,
2723 eos,
2724 !.
2725header(_) -->
2726 string(S), blanks_to_nl,
2727 !,
2728 { string_codes(Line, S),
2729 syntax_error(http_parameter(Line))
2730 }.
2731
2743
2744:- multifile
2745 http:http_address//0. 2746
2747address -->
2748 http:http_address,
2749 !.
2750address -->
2751 { gethostname(Host) },
2752 html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
2753 ' httpd at ', Host
2754 ])).
2755
2756mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
2757mkfield(Name, Value, [Att|Tail], Tail) :-
2758 Att =.. [Name, Value].
2759
2765
2795
2796
2797 2800
2801:- multifile
2802 prolog:message//1,
2803 prolog:error_message//1. 2804
2805prolog:error_message(http_write_short(Data, Sent)) -->
2806 data(Data),
2807 [ ': remote hangup after ~D bytes'-[Sent] ].
2808prolog:error_message(syntax_error(http_request(Request))) -->
2809 [ 'Illegal HTTP request: ~s'-[Request] ].
2810prolog:error_message(syntax_error(http_parameter(Line))) -->
2811 [ 'Illegal HTTP parameter: ~s'-[Line] ].
2812
2813prolog:message(http(skipped_cookie(S))) -->
2814 [ 'Skipped illegal cookie: ~s'-[S] ].
2815
2816data(bytes(MimeType, _Bytes)) -->
2817 !,
2818 [ 'bytes(~p, ...)'-[MimeType] ].
2819data(Data) -->
2820 [ '~p'-[Data] ]