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 !.
1078http_post_data(html(HTML), Out, HdrExtra) :-
1079 !,
1080 phrase(post_header(html(HTML), HdrExtra), Header),
1081 send_request_header(Out, Header),
1082 print_html(Out, HTML).
1083http_post_data(xml(XML), Out, HdrExtra) :-
1084 !,
1085 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
1086http_post_data(xml(Type, XML), Out, HdrExtra) :-
1087 !,
1088 http_post_data(xml(Type, XML, []), Out, HdrExtra).
1089http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
1090 !,
1091 setup_call_cleanup(
1092 new_memory_file(MemFile),
1093 ( setup_call_cleanup(
1094 open_memory_file(MemFile, write, MemOut),
1095 xml_write(MemOut, XML, Options),
1096 close(MemOut)),
1097 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
1098 ),
1099 free_memory_file(MemFile)).
1100http_post_data(file(File), Out, HdrExtra) :-
1101 !,
1102 ( file_mime_type(File, Type)
1103 -> true
1104 ; Type = text/plain
1105 ),
1106 http_post_data(file(Type, File), Out, HdrExtra).
1107http_post_data(file(Type, File), Out, HdrExtra) :-
1108 !,
1109 phrase(post_header(file(Type, File), HdrExtra), Header),
1110 send_request_header(Out, Header),
1111 setup_call_cleanup(
1112 open(File, read, In, [type(binary)]),
1113 copy_stream_data(In, Out),
1114 close(In)).
1115http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
1116 !,
1117 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1118 send_request_header(Out, Header),
1119 setup_call_cleanup(
1120 open_memory_file(Handle, read, In, [encoding(octet)]),
1121 copy_stream_data(In, Out),
1122 close(In)).
1123http_post_data(codes(Codes), Out, HdrExtra) :-
1124 !,
1125 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1126http_post_data(codes(Type, Codes), Out, HdrExtra) :-
1127 !,
1128 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1129 send_request_header(Out, Header),
1130 setup_call_cleanup(
1131 set_stream(Out, encoding(utf8)),
1132 format(Out, '~s', [Codes]),
1133 set_stream(Out, encoding(octet))).
1134http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
1135 !,
1136 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1137 send_request_header(Out, Header),
1138 format(Out, '~s', [Bytes]).
1139http_post_data(atom(Atom), Out, HdrExtra) :-
1140 !,
1141 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1142http_post_data(atom(Type, Atom), Out, HdrExtra) :-
1143 !,
1144 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1145 send_request_header(Out, Header),
1146 setup_call_cleanup(
1147 set_stream(Out, encoding(utf8)),
1148 write(Out, Atom),
1149 set_stream(Out, encoding(octet))).
1150http_post_data(string(String), Out, HdrExtra) :-
1151 !,
1152 http_post_data(atom(text/plain, String), Out, HdrExtra).
1153http_post_data(string(Type, String), Out, HdrExtra) :-
1154 !,
1155 phrase(post_header(string(Type, String), HdrExtra), Header),
1156 send_request_header(Out, Header),
1157 setup_call_cleanup(
1158 set_stream(Out, encoding(utf8)),
1159 write(Out, String),
1160 set_stream(Out, encoding(octet))).
1161http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
1162 !,
1163 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1164 http_post_data(cgi_stream(In), Out, HdrExtra).
1165http_post_data(cgi_stream(In), Out, HdrExtra) :-
1166 !,
1167 http_read_header(In, Header0),
1168 http_update_encoding(Header0, Encoding, Header),
1169 content_length_in_encoding(Encoding, In, Size),
1170 http_join_headers(HdrExtra, Header, Hdr2),
1171 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1172 send_request_header(Out, HeaderText),
1173 setup_call_cleanup(
1174 set_stream(Out, encoding(Encoding)),
1175 copy_stream_data(In, Out),
1176 set_stream(Out, encoding(octet))).
1177http_post_data(form(Fields), Out, HdrExtra) :-
1178 !,
1179 parse_url_search(Codes, Fields),
1180 length(Codes, Size),
1181 http_join_headers(HdrExtra,
1182 [ content_type('application/x-www-form-urlencoded')
1183 ], Header),
1184 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1185 send_request_header(Out, HeaderChars),
1186 format(Out, '~s', [Codes]).
1187http_post_data(form_data(Data), Out, HdrExtra) :-
1188 !,
1189 setup_call_cleanup(
1190 new_memory_file(MemFile),
1191 ( setup_call_cleanup(
1192 open_memory_file(MemFile, write, MimeOut),
1193 mime_pack(Data, MimeOut, Boundary),
1194 close(MimeOut)),
1195 size_memory_file(MemFile, Size, octet),
1196 format(string(ContentType),
1197 'multipart/form-data; boundary=~w', [Boundary]),
1198 http_join_headers(HdrExtra,
1199 [ mime_version('1.0'),
1200 content_type(ContentType)
1201 ], Header),
1202 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1203 send_request_header(Out, HeaderChars),
1204 setup_call_cleanup(
1205 open_memory_file(MemFile, read, In, [encoding(octet)]),
1206 copy_stream_data(In, Out),
1207 close(In))
1208 ),
1209 free_memory_file(MemFile)).
1210http_post_data(List, Out, HdrExtra) :- 1211 is_list(List),
1212 !,
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] ]