35
36:- module(http_header,
37 [ http_read_request/2, 38 http_read_reply_header/2, 39 http_reply/2, 40 http_reply/3, 41 http_reply/4, 42 http_reply/5, 43 44 http_reply/6, 45 46 http_reply_header/3, 47 http_status_reply/4, 48 http_status_reply/5, 49 50
51 http_timestamp/2, 52
53 http_post_data/3, 54
55 http_read_header/2, 56 http_parse_header/2, 57 http_parse_header_value/3, 58 http_join_headers/3, 59 http_update_encoding/3, 60 http_update_connection/4, 61 http_update_transfer/4 62 ]). 63:- autoload(html_write,
64 [ print_html/2, print_html/1, page/4, html/3,
65 html_print_length/2
66 ]). 67:- if(exists_source(http_exception)). 68:- autoload(http_exception,[map_exception_to_http_status/4]). 69:- endif. 70:- autoload(mimepack,[mime_pack/3]). 71:- autoload(mimetype,[file_mime_type/2]). 72:- autoload(library(apply),[maplist/2]). 73:- autoload(library(base64),[base64/2]). 74:- use_module(library(debug),[debug/3,debugging/1]). 75:- autoload(library(error),[syntax_error/1,domain_error/2]). 76:- autoload(library(lists),[append/3,member/2,select/3,delete/3]). 77:- autoload(library(memfile),
78 [ new_memory_file/1, open_memory_file/3,
79 free_memory_file/1, open_memory_file/4,
80 size_memory_file/3
81 ]). 82:- autoload(library(option),[option/3,option/2]). 83:- autoload(library(pairs),[pairs_values/2]). 84:- autoload(library(readutil),
85 [read_line_to_codes/2,read_line_to_codes/3]). 86:- autoload(library(sgml_write),[xml_write/3]). 87:- autoload(library(socket),[gethostname/1]). 88:- autoload(library(uri),
89 [ uri_components/2, uri_data/3, uri_encoded/3, uri_query_components/2
90 ]). 91:- autoload(library(url),[parse_url_search/2]). 92:- autoload(library(dcg/basics),
93 [ integer/3, atom/3, whites/2, blanks_to_nl/2, string/3,
94 number/3, blanks/2, float/3, nonblanks/3, eos/2
95 ]). 96:- use_module(library(settings),[setting/4,setting/2]). 97
98:- multifile
99 http:status_page/3, 100 http:status_reply/3, 101 http:serialize_reply/2, 102 http:post_data_hook/3, 103 http:mime_type_encoding/2. 104
106
107:- setting(http:chunked_transfer, oneof([never,on_request,if_possible]),
108 on_request, 'When to use Transfer-Encoding: Chunked'). 109
110
117
118:- discontiguous
119 term_expansion/2. 120
121
122 125
131
132http_read_request(In, Request) :-
133 catch(read_line_to_codes(In, Codes), E, true),
134 ( var(E)
135 -> ( Codes == end_of_file
136 -> debug(http(header), 'end-of-file', []),
137 Request = end_of_file
138 ; debug(http(header), 'First line: ~s', [Codes]),
139 Request = [input(In)|Request1],
140 phrase(request(In, Request1), Codes),
141 ( Request1 = [unknown(Text)|_]
142 -> string_codes(S, Text),
143 syntax_error(http_request(S))
144 ; true
145 )
146 )
147 ; ( debugging(http(request))
148 -> message_to_string(E, Msg),
149 debug(http(request), "Exception reading 1st line: ~s", [Msg])
150 ; true
151 ),
152 Request = end_of_file
153 ).
154
155
160
(In, [input(In)|Reply]) :-
162 read_line_to_codes(In, Codes),
163 ( Codes == end_of_file
164 -> debug(http(header), 'end-of-file', []),
165 throw(error(syntax(http_reply_header, end_of_file), _))
166 ; debug(http(header), 'First line: ~s~n', [Codes]),
167 ( phrase(reply(In, Reply), Codes)
168 -> true
169 ; atom_codes(Header, Codes),
170 syntax_error(http_reply_header(Header))
171 )
172 ).
173
174
175 178
225
226http_reply(What, Out) :-
227 http_reply(What, Out, [connection(close)], _).
228
229http_reply(Data, Out, HdrExtra) :-
230 http_reply(Data, Out, HdrExtra, _Code).
231
232http_reply(Data, Out, HdrExtra, Code) :-
233 http_reply(Data, Out, HdrExtra, [], Code).
234
235http_reply(Data, Out, HdrExtra, Context, Code) :-
236 http_reply(Data, Out, HdrExtra, Context, [method(get)], Code).
237
238http_reply(Data, Out, HdrExtra, _Context, Request, Code) :-
239 byte_count(Out, C0),
240 memberchk(method(Method), Request),
241 catch(http_reply_data(Data, Out, HdrExtra, Method, Code), E, true),
242 !,
243 ( var(E)
244 -> true
245 ; ( E = error(io_error(write,_), _)
246 ; E = error(socket_error(_,_), _)
247 )
248 -> byte_count(Out, C1),
249 Sent is C1 - C0,
250 throw(error(http_write_short(Data, Sent), _))
251 ; E = error(timeout_error(write, _), _)
252 -> throw(E)
253 ; map_exception_to_http_status(E, Status, NewHdr, NewContext)
254 -> http_status_reply(Status, Out, NewHdr, NewContext, Request, Code)
255 ; throw(E)
256 ).
257http_reply(Status, Out, HdrExtra, Context, Request, Code) :-
258 http_status_reply(Status, Out, HdrExtra, Context, Request, Code).
259
260:- if(\+current_predicate(map_exception_to_http_status/4)). 261map_exception_to_http_status(_E, _Status, _NewHdr, _NewContext) :-
262 fail.
263:- endif. 264
265:- meta_predicate
266 if_no_head(0, +). 267
274
275http_reply_data(Data, Out, HdrExtra, Method, Code) :-
276 http_reply_data_(Data, Out, HdrExtra, Method, Code),
277 flush_output(Out).
278
279http_reply_data_(html(HTML), Out, HdrExtra, Method, Code) :-
280 !,
281 phrase(reply_header(html(HTML), HdrExtra, Code), Header),
282 send_reply_header(Out, Header),
283 if_no_head(print_html(Out, HTML), Method).
284http_reply_data_(file(Type, File), Out, HdrExtra, Method, Code) :-
285 !,
286 phrase(reply_header(file(Type, File), HdrExtra, Code), Header),
287 reply_file(Out, File, Header, Method).
288http_reply_data_(gzip_file(Type, File), Out, HdrExtra, Method, Code) :-
289 !,
290 phrase(reply_header(gzip_file(Type, File), HdrExtra, Code), Header),
291 reply_file(Out, File, Header, Method).
292http_reply_data_(file(Type, File, Range), Out, HdrExtra, Method, Code) :-
293 !,
294 phrase(reply_header(file(Type, File, Range), HdrExtra, Code), Header),
295 reply_file_range(Out, File, Header, Range, Method).
296http_reply_data_(tmp_file(Type, File), Out, HdrExtra, Method, Code) :-
297 !,
298 phrase(reply_header(tmp_file(Type, File), HdrExtra, Code), Header),
299 reply_file(Out, File, Header, Method).
300http_reply_data_(bytes(Type, Bytes), Out, HdrExtra, Method, Code) :-
301 !,
302 phrase(reply_header(bytes(Type, Bytes), HdrExtra, Code), Header),
303 send_reply_header(Out, Header),
304 if_no_head(format(Out, '~s', [Bytes]), Method).
305http_reply_data_(stream(In, Len), Out, HdrExtra, Method, Code) :-
306 !,
307 phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header),
308 copy_stream(Out, In, Header, Method, 0, end).
309http_reply_data_(cgi_stream(In, Len), Out, HdrExtra, Method, Code) :-
310 !,
311 http_read_header(In, CgiHeader),
312 seek(In, 0, current, Pos),
313 Size is Len - Pos,
314 http_join_headers(HdrExtra, CgiHeader, Hdr2),
315 phrase(reply_header(cgi_data(Size), Hdr2, Code), Header),
316 copy_stream(Out, In, Header, Method, 0, end).
317
318if_no_head(_, head) :-
319 !.
320if_no_head(Goal, _) :-
321 call(Goal).
322
323reply_file(Out, _File, Header, head) :-
324 !,
325 send_reply_header(Out, Header).
326reply_file(Out, File, Header, _) :-
327 setup_call_cleanup(
328 open(File, read, In, [type(binary)]),
329 copy_stream(Out, In, Header, 0, end),
330 close(In)).
331
332reply_file_range(Out, _File, Header, _Range, head) :-
333 !,
334 send_reply_header(Out, Header).
335reply_file_range(Out, File, Header, bytes(From, To), _) :-
336 setup_call_cleanup(
337 open(File, read, In, [type(binary)]),
338 copy_stream(Out, In, Header, From, To),
339 close(In)).
340
341copy_stream(Out, _, Header, head, _, _) :-
342 !,
343 send_reply_header(Out, Header).
344copy_stream(Out, In, Header, _, From, To) :-
345 copy_stream(Out, In, Header, From, To).
346
347copy_stream(Out, In, Header, From, To) :-
348 ( From == 0
349 -> true
350 ; seek(In, From, bof, _)
351 ),
352 peek_byte(In, _),
353 send_reply_header(Out, Header),
354 ( To == end
355 -> copy_stream_data(In, Out)
356 ; Len is To - From,
357 copy_stream_data(In, Out, Len)
358 ).
359
360
391
392http_status_reply(Status, Out, Options) :-
393 _{header:HdrExtra, context:Context, code:Code, method:Method} :< Options,
394 http_status_reply(Status, Out, HdrExtra, Context, [method(Method)], Code).
395
396http_status_reply(Status, Out, HdrExtra, Code) :-
397 http_status_reply(Status, Out, HdrExtra, [], Code).
398
399http_status_reply(Status, Out, HdrExtra, Context, Code) :-
400 http_status_reply(Status, Out, HdrExtra, Context, [method(get)], Code).
401
402http_status_reply(Status, Out, HdrExtra, Context, Request, Code) :-
403 option(method(Method), Request, get),
404 parsed_accept(Request, Accept),
405 status_reply_flush(Status, Out,
406 _{ context: Context,
407 method: Method,
408 code: Code,
409 accept: Accept,
410 header: HdrExtra
411 }).
412
413parsed_accept(Request, Accept) :-
414 memberchk(accept(Accept0), Request),
415 http_parse_header_value(accept, Accept0, Accept1),
416 !,
417 Accept = Accept1.
418parsed_accept(_, [ media(text/html, [], 0.1, []),
419 media(_, [], 0.01, [])
420 ]).
421
422status_reply_flush(Status, Out, Options) :-
423 status_reply(Status, Out, Options),
424 !,
425 flush_output(Out).
426
437
439status_reply(no_content, Out, Options) :-
440 !,
441 phrase(reply_header(status(no_content), Options), Header),
442 send_reply_header(Out, Header).
443status_reply(switching_protocols(_Goal,SwitchOptions), Out, Options) :-
444 !,
445 ( option(headers(Extra1), SwitchOptions)
446 -> true
447 ; option(header(Extra1), SwitchOptions, [])
448 ),
449 http_join_headers(Options.header, Extra1, HdrExtra),
450 phrase(reply_header(status(switching_protocols),
451 Options.put(header,HdrExtra)), Header),
452 send_reply_header(Out, Header).
453status_reply(authorise(basic, ''), Out, Options) :-
454 !,
455 status_reply(authorise(basic), Out, Options).
456status_reply(authorise(basic, Realm), Out, Options) :-
457 !,
458 status_reply(authorise(basic(Realm)), Out, Options).
459status_reply(not_modified, Out, Options) :-
460 !,
461 phrase(reply_header(status(not_modified), Options), Header),
462 send_reply_header(Out, Header).
464status_reply(busy, Out, Options) :-
465 status_reply(service_unavailable(busy), Out, Options).
466status_reply(unavailable(Why), Out, Options) :-
467 status_reply(service_unavailable(Why), Out, Options).
468status_reply(resource_error(Why), Out, Options) :-
469 status_reply(service_unavailable(Why), Out, Options).
471status_reply(Status, Out, Options) :-
472 status_has_content(Status),
473 status_page_hook(Status, Reply, Options),
474 serialize_body(Reply, Body),
475 Status =.. List,
476 append(List, [Body], ExList),
477 ExStatus =.. ExList,
478 phrase(reply_header(ExStatus, Options), Header),
479 send_reply_header(Out, Header),
480 reply_status_body(Out, Body, Options).
481
486
487status_has_content(created(_Location)).
488status_has_content(moved(_To)).
489status_has_content(moved_temporary(_To)).
490status_has_content(gone(_URL)).
491status_has_content(see_other(_To)).
492status_has_content(bad_request(_ErrorTerm)).
493status_has_content(authorise(_Method)).
494status_has_content(forbidden(_URL)).
495status_has_content(not_found(_URL)).
496status_has_content(method_not_allowed(_Method, _URL)).
497status_has_content(not_acceptable(_Why)).
498status_has_content(server_error(_ErrorTerm)).
499status_has_content(service_unavailable(_Why)).
500
509
510serialize_body(Reply, Body) :-
511 http:serialize_reply(Reply, Body),
512 !.
513serialize_body(html_tokens(Tokens), body(text/html, utf8, Content)) :-
514 !,
515 with_output_to(string(Content), print_html(Tokens)).
516serialize_body(Reply, Reply) :-
517 Reply = body(_,_,_),
518 !.
519serialize_body(Reply, _) :-
520 domain_error(http_reply_body, Reply).
521
522reply_status_body(_, _, Options) :-
523 Options.method == head,
524 !.
525reply_status_body(Out, body(_Type, Encoding, Content), _Options) :-
526 ( Encoding == octet
527 -> format(Out, '~s', [Content])
528 ; setup_call_cleanup(
529 set_stream(Out, encoding(Encoding)),
530 format(Out, '~s', [Content]),
531 set_stream(Out, encoding(octet)))
532 ).
533
543
558
559status_page_hook(Term, Reply, Options) :-
560 Context = Options.context,
561 functor(Term, Name, _),
562 status_number_fact(Name, Code),
563 ( Options.code = Code,
564 http:status_reply(Term, Reply, Options)
565 ; http:status_page(Term, Context, HTML),
566 Reply = html_tokens(HTML)
567 ; http:status_page(Code, Context, HTML), 568 Reply = html_tokens(HTML)
569 ),
570 !.
571status_page_hook(created(Location), html_tokens(HTML), _Options) :-
572 phrase(page([ title('201 Created')
573 ],
574 [ h1('Created'),
575 p(['The document was created ',
576 a(href(Location), ' Here')
577 ]),
578 \address
579 ]),
580 HTML).
581status_page_hook(moved(To), html_tokens(HTML), _Options) :-
582 phrase(page([ title('301 Moved Permanently')
583 ],
584 [ h1('Moved Permanently'),
585 p(['The document has moved ',
586 a(href(To), ' Here')
587 ]),
588 \address
589 ]),
590 HTML).
591status_page_hook(moved_temporary(To), html_tokens(HTML), _Options) :-
592 phrase(page([ title('302 Moved Temporary')
593 ],
594 [ h1('Moved Temporary'),
595 p(['The document is currently ',
596 a(href(To), ' Here')
597 ]),
598 \address
599 ]),
600 HTML).
601status_page_hook(gone(URL), html_tokens(HTML), _Options) :-
602 phrase(page([ title('410 Resource Gone')
603 ],
604 [ h1('Resource Gone'),
605 p(['The document has been removed ',
606 a(href(URL), ' from here')
607 ]),
608 \address
609 ]),
610 HTML).
611status_page_hook(see_other(To), html_tokens(HTML), _Options) :-
612 phrase(page([ title('303 See Other')
613 ],
614 [ h1('See Other'),
615 p(['See other document ',
616 a(href(To), ' Here')
617 ]),
618 \address
619 ]),
620 HTML).
621status_page_hook(bad_request(ErrorTerm), html_tokens(HTML), _Options) :-
622 '$messages':translate_message(ErrorTerm, Lines, []),
623 phrase(page([ title('400 Bad Request')
624 ],
625 [ h1('Bad Request'),
626 p(\html_message_lines(Lines)),
627 \address
628 ]),
629 HTML).
630status_page_hook(authorise(_Method), html_tokens(HTML), _Options):-
631 phrase(page([ title('401 Authorization Required')
632 ],
633 [ h1('Authorization Required'),
634 p(['This server could not verify that you ',
635 'are authorized to access the document ',
636 'requested. Either you supplied the wrong ',
637 'credentials (e.g., bad password), or your ',
638 'browser doesn\'t understand how to supply ',
639 'the credentials required.'
640 ]),
641 \address
642 ]),
643 HTML).
644status_page_hook(forbidden(URL), html_tokens(HTML), _Options) :-
645 phrase(page([ title('403 Forbidden')
646 ],
647 [ h1('Forbidden'),
648 p(['You don\'t have permission to access ', URL,
649 ' on this server'
650 ]),
651 \address
652 ]),
653 HTML).
654status_page_hook(not_found(URL), html_tokens(HTML), _Options) :-
655 phrase(page([ title('404 Not Found')
656 ],
657 [ h1('Not Found'),
658 p(['The requested URL ', tt(URL),
659 ' was not found on this server'
660 ]),
661 \address
662 ]),
663 HTML).
664status_page_hook(method_not_allowed(Method,URL), html_tokens(HTML), _Options) :-
665 upcase_atom(Method, UMethod),
666 phrase(page([ title('405 Method not allowed')
667 ],
668 [ h1('Method not allowed'),
669 p(['The requested URL ', tt(URL),
670 ' does not support method ', tt(UMethod), '.'
671 ]),
672 \address
673 ]),
674 HTML).
675status_page_hook(not_acceptable(WhyHTML), html_tokens(HTML), _Options) :-
676 phrase(page([ title('406 Not Acceptable')
677 ],
678 [ h1('Not Acceptable'),
679 WhyHTML,
680 \address
681 ]),
682 HTML).
683status_page_hook(server_error(ErrorTerm), html_tokens(HTML), _Options) :-
684 '$messages':translate_message(ErrorTerm, Lines, []),
685 phrase(page([ title('500 Internal server error')
686 ],
687 [ h1('Internal server error'),
688 p(\html_message_lines(Lines)),
689 \address
690 ]),
691 HTML).
692status_page_hook(service_unavailable(Why), html_tokens(HTML), _Options) :-
693 phrase(page([ title('503 Service Unavailable')
694 ],
695 [ h1('Service Unavailable'),
696 \unavailable(Why),
697 \address
698 ]),
699 HTML).
700
701unavailable(busy) -->
702 html(p(['The server is temporarily out of resources, ',
703 'please try again later'])).
704unavailable(error(Formal,Context)) -->
705 { '$messages':translate_message(error(Formal,Context), Lines, []) },
706 html_message_lines(Lines).
707unavailable(HTML) -->
708 html(HTML).
709
710html_message_lines([]) -->
711 [].
712html_message_lines([nl|T]) -->
713 !,
714 html([br([])]),
715 html_message_lines(T).
716html_message_lines([flush]) -->
717 [].
718html_message_lines([ansi(_Style,Fmt,Args)|T]) -->
719 !,
720 { format(string(S), Fmt, Args)
721 },
722 html([S]),
723 html_message_lines(T).
724html_message_lines([url(Pos)|T]) -->
725 !,
726 msg_url(Pos),
727 html_message_lines(T).
728html_message_lines([url(URL, Label)|T]) -->
729 !,
730 html(a(href(URL), Label)),
731 html_message_lines(T).
732html_message_lines([Fmt-Args|T]) -->
733 !,
734 { format(string(S), Fmt, Args)
735 },
736 html([S]),
737 html_message_lines(T).
738html_message_lines([Fmt|T]) -->
739 !,
740 { format(string(S), Fmt, [])
741 },
742 html([S]),
743 html_message_lines(T).
744
745msg_url(File:Line:Pos) -->
746 !,
747 html([File, :, Line, :, Pos]).
748msg_url(File:Line) -->
749 !,
750 html([File, :, Line]).
751msg_url(File) -->
752 html([File]).
753
758
([], H, H).
760http_join_headers([H|T], Hdr0, Hdr) :-
761 functor(H, N, A),
762 functor(H2, N, A),
763 member(H2, Hdr0),
764 !,
765 http_join_headers(T, Hdr0, Hdr).
766http_join_headers([H|T], Hdr0, [H|Hdr]) :-
767 http_join_headers(T, Hdr0, Hdr).
768
769
778
779http_update_encoding(Header0, utf8, [content_type(Type)|Header]) :-
780 select(content_type(Type0), Header0, Header),
781 sub_atom(Type0, 0, _, _, 'text/'),
782 !,
783 ( sub_atom(Type0, S, _, _, ';')
784 -> sub_atom(Type0, 0, S, _, B)
785 ; B = Type0
786 ),
787 atom_concat(B, '; charset=UTF-8', Type).
788http_update_encoding(Header, Encoding, Header) :-
789 memberchk(content_type(Type), Header),
790 ( sub_atom_icasechk(Type, _, 'utf-8')
791 -> Encoding = utf8
792 ; http:mime_type_encoding(Type, Encoding)
793 -> true
794 ; mime_type_encoding(Type, Encoding)
795 ).
796http_update_encoding(Header, octet, Header).
797
802
803mime_type_encoding('application/json', utf8).
804mime_type_encoding('application/jsonrequest', utf8).
805mime_type_encoding('application/x-prolog', utf8).
806mime_type_encoding('application/n-quads', utf8).
807mime_type_encoding('application/n-triples', utf8).
808mime_type_encoding('application/sparql-query', utf8).
809mime_type_encoding('application/trig', utf8).
810mime_type_encoding('application/sparql-results+json', utf8).
811mime_type_encoding('application/sparql-results+xml', utf8).
812
820
821
826
827http_update_connection(CgiHeader, Request, Connect,
828 [connection(Connect)|Rest]) :-
829 select(connection(CgiConn), CgiHeader, Rest),
830 !,
831 connection(Request, ReqConnection),
832 join_connection(ReqConnection, CgiConn, Connect).
833http_update_connection(CgiHeader, Request, Connect,
834 [connection(Connect)|CgiHeader]) :-
835 connection(Request, Connect).
836
837join_connection(Keep1, Keep2, Connection) :-
838 ( downcase_atom(Keep1, 'keep-alive'),
839 downcase_atom(Keep2, 'keep-alive')
840 -> Connection = 'Keep-Alive'
841 ; Connection = close
842 ).
843
844
848
849connection(Header, Close) :-
850 ( memberchk(connection(Connection), Header)
851 -> Close = Connection
852 ; memberchk(http_version(1-X), Header),
853 X >= 1
854 -> Close = 'Keep-Alive'
855 ; Close = close
856 ).
857
858
874
875http_update_transfer(Request, CgiHeader, Transfer, Header) :-
876 setting(http:chunked_transfer, When),
877 http_update_transfer(When, Request, CgiHeader, Transfer, Header).
878
879http_update_transfer(never, _, CgiHeader, none, Header) :-
880 !,
881 delete(CgiHeader, transfer_encoding(_), Header).
882http_update_transfer(_, _, CgiHeader, none, Header) :-
883 memberchk(location(_), CgiHeader),
884 !,
885 delete(CgiHeader, transfer_encoding(_), Header).
886http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
887 select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
888 !,
889 transfer(Request, ReqConnection),
890 join_transfer(ReqConnection, CgiTransfer, Transfer),
891 ( Transfer == none
892 -> Header = Rest
893 ; Header = [transfer_encoding(Transfer)|Rest]
894 ).
895http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
896 transfer(Request, Transfer),
897 Transfer \== none,
898 !,
899 Header = [transfer_encoding(Transfer)|CgiHeader].
900http_update_transfer(_, _, CgiHeader, none, CgiHeader).
901
902join_transfer(chunked, chunked, chunked) :- !.
903join_transfer(_, _, none).
904
905
909
910transfer(Header, Transfer) :-
911 ( memberchk(transfer_encoding(Transfer0), Header)
912 -> Transfer = Transfer0
913 ; memberchk(http_version(1-X), Header),
914 X >= 1
915 -> Transfer = chunked
916 ; Transfer = none
917 ).
918
919
925
926content_length_in_encoding(Enc, Stream, Bytes) :-
927 stream_property(Stream, position(Here)),
928 setup_call_cleanup(
929 open_null_stream(Out),
930 ( set_stream(Out, encoding(Enc)),
931 catch(copy_stream_data(Stream, Out), _, fail),
932 flush_output(Out),
933 byte_count(Out, Bytes)
934 ),
935 ( close(Out, [force(true)]),
936 set_stream_position(Stream, Here)
937 )).
938
939
940 943
1049
1050http_post_data(Data, Out, HdrExtra) :-
1051 http:post_data_hook(Data, Out, HdrExtra),
1052 !.
1053http_post_data(html(HTML), Out, HdrExtra) :-
1054 !,
1055 phrase(post_header(html(HTML), HdrExtra), Header),
1056 send_request_header(Out, Header),
1057 print_html(Out, HTML).
1058http_post_data(xml(XML), Out, HdrExtra) :-
1059 !,
1060 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
1061http_post_data(xml(Type, XML), Out, HdrExtra) :-
1062 !,
1063 http_post_data(xml(Type, XML, []), Out, HdrExtra).
1064http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
1065 !,
1066 setup_call_cleanup(
1067 new_memory_file(MemFile),
1068 ( setup_call_cleanup(
1069 open_memory_file(MemFile, write, MemOut),
1070 xml_write(MemOut, XML, Options),
1071 close(MemOut)),
1072 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
1073 ),
1074 free_memory_file(MemFile)).
1075http_post_data(file(File), Out, HdrExtra) :-
1076 !,
1077 ( file_mime_type(File, Type)
1078 -> true
1079 ; Type = text/plain
1080 ),
1081 http_post_data(file(Type, File), Out, HdrExtra).
1082http_post_data(file(Type, File), Out, HdrExtra) :-
1083 !,
1084 phrase(post_header(file(Type, File), HdrExtra), Header),
1085 send_request_header(Out, Header),
1086 setup_call_cleanup(
1087 open(File, read, In, [type(binary)]),
1088 copy_stream_data(In, Out),
1089 close(In)).
1090http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
1091 !,
1092 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1093 send_request_header(Out, Header),
1094 setup_call_cleanup(
1095 open_memory_file(Handle, read, In, [encoding(octet)]),
1096 copy_stream_data(In, Out),
1097 close(In)).
1098http_post_data(codes(Codes), Out, HdrExtra) :-
1099 !,
1100 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1101http_post_data(codes(Type, Codes), Out, HdrExtra) :-
1102 !,
1103 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1104 send_request_header(Out, Header),
1105 setup_call_cleanup(
1106 set_stream(Out, encoding(utf8)),
1107 format(Out, '~s', [Codes]),
1108 set_stream(Out, encoding(octet))).
1109http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
1110 !,
1111 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1112 send_request_header(Out, Header),
1113 format(Out, '~s', [Bytes]).
1114http_post_data(atom(Atom), Out, HdrExtra) :-
1115 !,
1116 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1117http_post_data(atom(Type, Atom), Out, HdrExtra) :-
1118 !,
1119 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1120 send_request_header(Out, Header),
1121 setup_call_cleanup(
1122 set_stream(Out, encoding(utf8)),
1123 write(Out, Atom),
1124 set_stream(Out, encoding(octet))).
1125http_post_data(string(String), Out, HdrExtra) :-
1126 !,
1127 http_post_data(atom(text/plain, String), Out, HdrExtra).
1128http_post_data(string(Type, String), Out, HdrExtra) :-
1129 !,
1130 phrase(post_header(string(Type, String), HdrExtra), Header),
1131 send_request_header(Out, Header),
1132 setup_call_cleanup(
1133 set_stream(Out, encoding(utf8)),
1134 write(Out, String),
1135 set_stream(Out, encoding(octet))).
1136http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
1137 !,
1138 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1139 http_post_data(cgi_stream(In), Out, HdrExtra).
1140http_post_data(cgi_stream(In), Out, HdrExtra) :-
1141 !,
1142 http_read_header(In, Header0),
1143 http_update_encoding(Header0, Encoding, Header),
1144 content_length_in_encoding(Encoding, In, Size),
1145 http_join_headers(HdrExtra, Header, Hdr2),
1146 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1147 send_request_header(Out, HeaderText),
1148 setup_call_cleanup(
1149 set_stream(Out, encoding(Encoding)),
1150 copy_stream_data(In, Out),
1151 set_stream(Out, encoding(octet))).
1152http_post_data(form(Fields), Out, HdrExtra) :-
1153 !,
1154 parse_url_search(Codes, Fields),
1155 length(Codes, Size),
1156 http_join_headers(HdrExtra,
1157 [ content_type('application/x-www-form-urlencoded')
1158 ], Header),
1159 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1160 send_request_header(Out, HeaderChars),
1161 format(Out, '~s', [Codes]).
1162http_post_data(form_data(Data), Out, HdrExtra) :-
1163 !,
1164 setup_call_cleanup(
1165 new_memory_file(MemFile),
1166 ( setup_call_cleanup(
1167 open_memory_file(MemFile, write, MimeOut),
1168 mime_pack(Data, MimeOut, Boundary),
1169 close(MimeOut)),
1170 size_memory_file(MemFile, Size, octet),
1171 format(string(ContentType),
1172 'multipart/form-data; boundary=~w', [Boundary]),
1173 http_join_headers(HdrExtra,
1174 [ mime_version('1.0'),
1175 content_type(ContentType)
1176 ], Header),
1177 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1178 send_request_header(Out, HeaderChars),
1179 setup_call_cleanup(
1180 open_memory_file(MemFile, read, In, [encoding(octet)]),
1181 copy_stream_data(In, Out),
1182 close(In))
1183 ),
1184 free_memory_file(MemFile)).
1185http_post_data(List, Out, HdrExtra) :- 1186 is_list(List),
1187 !,
1188 setup_call_cleanup(
1189 new_memory_file(MemFile),
1190 ( setup_call_cleanup(
1191 open_memory_file(MemFile, write, MimeOut),
1192 mime_pack(List, MimeOut, Boundary),
1193 close(MimeOut)),
1194 size_memory_file(MemFile, Size, octet),
1195 format(string(ContentType),
1196 'multipart/mixed; boundary=~w', [Boundary]),
1197 http_join_headers(HdrExtra,
1198 [ mime_version('1.0'),
1199 content_type(ContentType)
1200 ], Header),
1201 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1202 send_request_header(Out, HeaderChars),
1203 setup_call_cleanup(
1204 open_memory_file(MemFile, read, In, [encoding(octet)]),
1205 copy_stream_data(In, Out),
1206 close(In))
1207 ),
1208 free_memory_file(MemFile)).
1209
1214
(html(Tokens), HdrExtra) -->
1216 header_fields(HdrExtra, Len),
1217 content_length(html(Tokens), Len),
1218 content_type(text/html),
1219 "\r\n".
1220post_header(file(Type, File), HdrExtra) -->
1221 header_fields(HdrExtra, Len),
1222 content_length(file(File), Len),
1223 content_type(Type),
1224 "\r\n".
1225post_header(memory_file(Type, File), HdrExtra) -->
1226 header_fields(HdrExtra, Len),
1227 content_length(memory_file(File), Len),
1228 content_type(Type),
1229 "\r\n".
1230post_header(cgi_data(Size), HdrExtra) -->
1231 header_fields(HdrExtra, Len),
1232 content_length(Size, Len),
1233 "\r\n".
1234post_header(codes(Type, Codes), HdrExtra) -->
1235 header_fields(HdrExtra, Len),
1236 content_length(codes(Codes, utf8), Len),
1237 content_type(Type, utf8),
1238 "\r\n".
1239post_header(bytes(Type, Bytes), HdrExtra) -->
1240 header_fields(HdrExtra, Len),
1241 content_length(bytes(Bytes), Len),
1242 content_type(Type),
1243 "\r\n".
1244post_header(atom(Type, Atom), HdrExtra) -->
1245 header_fields(HdrExtra, Len),
1246 content_length(atom(Atom, utf8), Len),
1247 content_type(Type, utf8),
1248 "\r\n".
1249post_header(string(Type, String), HdrExtra) -->
1250 header_fields(HdrExtra, Len),
1251 content_length(string(String, utf8), Len),
1252 content_type(Type, utf8),
1253 "\r\n".
1254
1255
1256 1259
1264
(Out, What, HdrExtra) :-
1266 phrase(reply_header(What, HdrExtra, _Code), String),
1267 !,
1268 send_reply_header(Out, String).
1269
1291
(Data, Dict) -->
1293 { _{header:HdrExtra, code:Code} :< Dict },
1294 reply_header(Data, HdrExtra, Code).
1295
(string(String), HdrExtra, Code) -->
1297 reply_header(string(text/plain, String), HdrExtra, Code).
1298reply_header(string(Type, String), HdrExtra, Code) -->
1299 vstatus(ok, Code, HdrExtra),
1300 date(now),
1301 header_fields(HdrExtra, CLen),
1302 content_length(codes(String, utf8), CLen),
1303 content_type(Type, utf8),
1304 "\r\n".
1305reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
1306 vstatus(ok, Code, HdrExtra),
1307 date(now),
1308 header_fields(HdrExtra, CLen),
1309 content_length(bytes(Bytes), CLen),
1310 content_type(Type),
1311 "\r\n".
1312reply_header(html(Tokens), HdrExtra, Code) -->
1313 vstatus(ok, Code, HdrExtra),
1314 date(now),
1315 header_fields(HdrExtra, CLen),
1316 content_length(html(Tokens), CLen),
1317 content_type(text/html),
1318 "\r\n".
1319reply_header(file(Type, File), HdrExtra, Code) -->
1320 vstatus(ok, Code, HdrExtra),
1321 date(now),
1322 modified(file(File)),
1323 header_fields(HdrExtra, CLen),
1324 content_length(file(File), CLen),
1325 content_type(Type),
1326 "\r\n".
1327reply_header(gzip_file(Type, File), HdrExtra, Code) -->
1328 vstatus(ok, Code, HdrExtra),
1329 date(now),
1330 modified(file(File)),
1331 header_fields(HdrExtra, CLen),
1332 content_length(file(File), CLen),
1333 content_type(Type),
1334 content_encoding(gzip),
1335 "\r\n".
1336reply_header(file(Type, File, Range), HdrExtra, Code) -->
1337 vstatus(partial_content, Code, HdrExtra),
1338 date(now),
1339 modified(file(File)),
1340 header_fields(HdrExtra, CLen),
1341 content_length(file(File, Range), CLen),
1342 content_type(Type),
1343 "\r\n".
1344reply_header(tmp_file(Type, File), HdrExtra, Code) -->
1345 vstatus(ok, Code, HdrExtra),
1346 date(now),
1347 header_fields(HdrExtra, CLen),
1348 content_length(file(File), CLen),
1349 content_type(Type),
1350 "\r\n".
1351reply_header(cgi_data(Size), HdrExtra, Code) -->
1352 vstatus(ok, Code, HdrExtra),
1353 date(now),
1354 header_fields(HdrExtra, CLen),
1355 content_length(Size, CLen),
1356 "\r\n".
1357reply_header(chunked_data, HdrExtra, Code) -->
1358 vstatus(ok, Code, HdrExtra),
1359 date(now),
1360 header_fields(HdrExtra, _),
1361 ( {memberchk(transfer_encoding(_), HdrExtra)}
1362 -> ""
1363 ; transfer_encoding(chunked)
1364 ),
1365 "\r\n".
1367reply_header(status(Status), HdrExtra, Code) -->
1368 vstatus(Status, Code),
1369 header_fields(HdrExtra, Clen),
1370 { Clen = 0 },
1371 "\r\n".
1373reply_header(Data, HdrExtra, Code) -->
1374 { status_reply_headers(Data,
1375 body(Type, Encoding, Content),
1376 ReplyHeaders),
1377 http_join_headers(ReplyHeaders, HdrExtra, Headers),
1378 functor(Data, CodeName, _)
1379 },
1380 vstatus(CodeName, Code, Headers),
1381 date(now),
1382 header_fields(Headers, CLen),
1383 content_length(codes(Content, Encoding), CLen),
1384 content_type(Type, Encoding),
1385 "\r\n".
1386
(created(Location, Body), Body,
1388 [ location(Location) ]).
1389status_reply_headers(moved(To, Body), Body,
1390 [ location(To) ]).
1391status_reply_headers(moved_temporary(To, Body), Body,
1392 [ location(To) ]).
1393status_reply_headers(gone(_URL, Body), Body, []).
1394status_reply_headers(see_other(To, Body), Body,
1395 [ location(To) ]).
1396status_reply_headers(authorise(Method, Body), Body,
1397 [ www_authenticate(Method) ]).
1398status_reply_headers(not_found(_URL, Body), Body, []).
1399status_reply_headers(forbidden(_URL, Body), Body, []).
1400status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
1401status_reply_headers(server_error(_Error, Body), Body, []).
1402status_reply_headers(service_unavailable(_Why, Body), Body, []).
1403status_reply_headers(not_acceptable(_Why, Body), Body, []).
1404status_reply_headers(bad_request(_Error, Body), Body, []).
1405
1406
1411
1412vstatus(_Status, Code, HdrExtra) -->
1413 {memberchk(status(Code), HdrExtra)},
1414 !,
1415 vstatus(_NewStatus, Code).
1416vstatus(Status, Code, _) -->
1417 vstatus(Status, Code).
1418
1419vstatus(Status, Code) -->
1420 "HTTP/1.1 ",
1421 status_number(Status, Code),
1422 " ",
1423 status_comment(Status),
1424 "\r\n".
1425
1432
1433status_number(Status, Code) -->
1434 { var(Status) },
1435 !,
1436 integer(Code),
1437 { status_number(Status, Code) },
1438 !.
1439status_number(Status, Code) -->
1440 { status_number(Status, Code) },
1441 integer(Code).
1442
1454
1462
1463status_number(Status, Code) :-
1464 nonvar(Status),
1465 !,
1466 status_number_fact(Status, Code).
1467status_number(Status, Code) :-
1468 nonvar(Code),
1469 !,
1470 ( between(100, 599, Code)
1471 -> ( status_number_fact(Status, Code)
1472 -> true
1473 ; ClassCode is Code // 100 * 100,
1474 status_number_fact(Status, ClassCode)
1475 )
1476 ; domain_error(http_code, Code)
1477 ).
1478
1479status_number_fact(continue, 100).
1480status_number_fact(switching_protocols, 101).
1481status_number_fact(ok, 200).
1482status_number_fact(created, 201).
1483status_number_fact(accepted, 202).
1484status_number_fact(non_authoritative_info, 203).
1485status_number_fact(no_content, 204).
1486status_number_fact(reset_content, 205).
1487status_number_fact(partial_content, 206).
1488status_number_fact(multiple_choices, 300).
1489status_number_fact(moved, 301).
1490status_number_fact(moved_temporary, 302).
1491status_number_fact(see_other, 303).
1492status_number_fact(not_modified, 304).
1493status_number_fact(use_proxy, 305).
1494status_number_fact(unused, 306).
1495status_number_fact(temporary_redirect, 307).
1496status_number_fact(bad_request, 400).
1497status_number_fact(authorise, 401).
1498status_number_fact(payment_required, 402).
1499status_number_fact(forbidden, 403).
1500status_number_fact(not_found, 404).
1501status_number_fact(method_not_allowed, 405).
1502status_number_fact(not_acceptable, 406).
1503status_number_fact(request_timeout, 408).
1504status_number_fact(conflict, 409).
1505status_number_fact(gone, 410).
1506status_number_fact(length_required, 411).
1507status_number_fact(payload_too_large, 413).
1508status_number_fact(uri_too_long, 414).
1509status_number_fact(unsupported_media_type, 415).
1510status_number_fact(expectation_failed, 417).
1511status_number_fact(upgrade_required, 426).
1512status_number_fact(server_error, 500).
1513status_number_fact(not_implemented, 501).
1514status_number_fact(bad_gateway, 502).
1515status_number_fact(service_unavailable, 503).
1516status_number_fact(gateway_timeout, 504).
1517status_number_fact(http_version_not_supported, 505).
1518
1519
1523
(continue) -->
1525 "Continue".
1526status_comment(switching_protocols) -->
1527 "Switching Protocols".
1528status_comment(ok) -->
1529 "OK".
1530status_comment(created) -->
1531 "Created".
1532status_comment(accepted) -->
1533 "Accepted".
1534status_comment(non_authoritative_info) -->
1535 "Non-Authoritative Information".
1536status_comment(no_content) -->
1537 "No Content".
1538status_comment(reset_content) -->
1539 "Reset Content".
1540status_comment(created) -->
1541 "Created".
1542status_comment(partial_content) -->
1543 "Partial content".
1544status_comment(multiple_choices) -->
1545 "Multiple Choices".
1546status_comment(moved) -->
1547 "Moved Permanently".
1548status_comment(moved_temporary) -->
1549 "Moved Temporary".
1550status_comment(see_other) -->
1551 "See Other".
1552status_comment(not_modified) -->
1553 "Not Modified".
1554status_comment(use_proxy) -->
1555 "Use Proxy".
1556status_comment(unused) -->
1557 "Unused".
1558status_comment(temporary_redirect) -->
1559 "Temporary Redirect".
1560status_comment(bad_request) -->
1561 "Bad Request".
1562status_comment(authorise) -->
1563 "Authorization Required".
1564status_comment(payment_required) -->
1565 "Payment Required".
1566status_comment(forbidden) -->
1567 "Forbidden".
1568status_comment(not_found) -->
1569 "Not Found".
1570status_comment(method_not_allowed) -->
1571 "Method Not Allowed".
1572status_comment(not_acceptable) -->
1573 "Not Acceptable".
1574status_comment(request_timeout) -->
1575 "Request Timeout".
1576status_comment(conflict) -->
1577 "Conflict".
1578status_comment(gone) -->
1579 "Gone".
1580status_comment(length_required) -->
1581 "Length Required".
1582status_comment(payload_too_large) -->
1583 "Payload Too Large".
1584status_comment(uri_too_long) -->
1585 "URI Too Long".
1586status_comment(unsupported_media_type) -->
1587 "Unsupported Media Type".
1588status_comment(expectation_failed) -->
1589 "Expectation Failed".
1590status_comment(upgrade_required) -->
1591 "Upgrade Required".
1592status_comment(server_error) -->
1593 "Internal Server Error".
1594status_comment(not_implemented) -->
1595 "Not Implemented".
1596status_comment(bad_gateway) -->
1597 "Bad Gateway".
1598status_comment(service_unavailable) -->
1599 "Service Unavailable".
1600status_comment(gateway_timeout) -->
1601 "Gateway Timeout".
1602status_comment(http_version_not_supported) -->
1603 "HTTP Version Not Supported".
1604
1605date(Time) -->
1606 "Date: ",
1607 ( { Time == now }
1608 -> now
1609 ; rfc_date(Time)
1610 ),
1611 "\r\n".
1612
1613modified(file(File)) -->
1614 !,
1615 { time_file(File, Time)
1616 },
1617 modified(Time).
1618modified(Time) -->
1619 "Last-modified: ",
1620 ( { Time == now }
1621 -> now
1622 ; rfc_date(Time)
1623 ),
1624 "\r\n".
1625
1626
1633
1634content_length(file(File, bytes(From, To)), Len) -->
1635 !,
1636 { size_file(File, Size),
1637 ( To == end
1638 -> Len is Size - From,
1639 RangeEnd is Size - 1
1640 ; Len is To+1 - From, 1641 RangeEnd = To
1642 )
1643 },
1644 content_range(bytes, From, RangeEnd, Size),
1645 content_length(Len, Len).
1646content_length(Reply, Len) -->
1647 { length_of(Reply, Len)
1648 },
1649 "Content-Length: ", integer(Len),
1650 "\r\n".
1651
1652
1653length_of(_, Len) :-
1654 nonvar(Len),
1655 !.
1656length_of(string(String, Encoding), Len) :-
1657 length_of(codes(String, Encoding), Len).
1658length_of(codes(String, Encoding), Len) :-
1659 !,
1660 setup_call_cleanup(
1661 open_null_stream(Out),
1662 ( set_stream(Out, encoding(Encoding)),
1663 format(Out, '~s', [String]),
1664 byte_count(Out, Len)
1665 ),
1666 close(Out)).
1667length_of(atom(Atom, Encoding), Len) :-
1668 !,
1669 setup_call_cleanup(
1670 open_null_stream(Out),
1671 ( set_stream(Out, encoding(Encoding)),
1672 format(Out, '~a', [Atom]),
1673 byte_count(Out, Len)
1674 ),
1675 close(Out)).
1676length_of(file(File), Len) :-
1677 !,
1678 size_file(File, Len).
1679length_of(memory_file(Handle), Len) :-
1680 !,
1681 size_memory_file(Handle, Len, octet).
1682length_of(html_tokens(Tokens), Len) :-
1683 !,
1684 html_print_length(Tokens, Len).
1685length_of(html(Tokens), Len) :- 1686 !,
1687 html_print_length(Tokens, Len).
1688length_of(bytes(Bytes), Len) :-
1689 !,
1690 ( string(Bytes)
1691 -> string_length(Bytes, Len)
1692 ; length(Bytes, Len) 1693 ).
1694length_of(Len, Len).
1695
1696
1701
1702content_range(Unit, From, RangeEnd, Size) -->
1703 "Content-Range: ", atom(Unit), " ",
1704 integer(From), "-", integer(RangeEnd), "/", integer(Size),
1705 "\r\n".
1706
1707content_encoding(Encoding) -->
1708 "Content-Encoding: ", atom(Encoding), "\r\n".
1709
1710transfer_encoding(Encoding) -->
1711 "Transfer-Encoding: ", atom(Encoding), "\r\n".
1712
1713content_type(Type) -->
1714 content_type(Type, _).
1715
1716content_type(Type, Charset) -->
1717 ctype(Type),
1718 charset(Charset),
1719 "\r\n".
1720
1721ctype(Main/Sub) -->
1722 !,
1723 "Content-Type: ",
1724 atom(Main),
1725 "/",
1726 atom(Sub).
1727ctype(Type) -->
1728 !,
1729 "Content-Type: ",
1730 atom(Type).
1731
1732charset(Var) -->
1733 { var(Var) },
1734 !.
1735charset(utf8) -->
1736 !,
1737 "; charset=UTF-8".
1738charset(CharSet) -->
1739 "; charset=",
1740 atom(CharSet).
1741
1747
(Name, Value) -->
1749 { var(Name) }, 1750 !,
1751 field_name(Name),
1752 ":",
1753 whites,
1754 read_field_value(ValueChars),
1755 blanks_to_nl,
1756 !,
1757 { field_to_prolog(Name, ValueChars, Value)
1758 -> true
1759 ; atom_codes(Value, ValueChars),
1760 domain_error(Name, Value)
1761 }.
1762header_field(Name, Value) -->
1763 field_name(Name),
1764 ": ",
1765 field_value(Name, Value),
1766 "\r\n".
1767
1771
1772read_field_value([H|T]) -->
1773 [H],
1774 { \+ code_type(H, space) },
1775 !,
1776 read_field_value(T).
1777read_field_value([]) -->
1778 "".
1779read_field_value([H|T]) -->
1780 [H],
1781 read_field_value(T).
1782
1787
(Out, String) :-
1789 debug(http(send_reply), "< ~s", [String]),
1790 format(Out, '~s', [String]).
1791
(Out, String) :-
1793 debug(http(send_request), "> ~s", [String]),
1794 format(Out, '~s', [String]).
1795
1833
(Field, Value, Prolog) :-
1835 known_field(Field, _, Type),
1836 ( already_parsed(Type, Value)
1837 -> Prolog = Value
1838 ; to_codes(Value, Codes),
1839 parse_header_value(Field, Codes, Prolog)
1840 ).
1841
1842already_parsed(integer, V) :- !, integer(V).
1843already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
1844already_parsed(Term, V) :- subsumes_term(Term, V).
1845
1846
1851
1852known_field(content_length, true, integer).
1853known_field(status, true, integer).
1854known_field(cookie, true, list(_=_)).
1855known_field(set_cookie, true, list(set_cookie(_Name,_Value,_Options))).
1856known_field(host, true, _Host:_Port).
1857known_field(range, maybe, bytes(_,_)).
1858known_field(accept, maybe, list(media(_Type, _Parms, _Q, _Exts))).
1859known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
1860known_field(content_type, false, media(_Type/_Sub, _Attributes)).
1861
1862to_codes(In, Codes) :-
1863 ( is_list(In)
1864 -> Codes = In
1865 ; atom_codes(In, Codes)
1866 ).
1867
1873
1874field_to_prolog(Field, Codes, Prolog) :-
1875 known_field(Field, true, _Type),
1876 !,
1877 ( parse_header_value(Field, Codes, Prolog0)
1878 -> Prolog = Prolog0
1879 ).
1880field_to_prolog(Field, Codes, Prolog) :-
1881 known_field(Field, maybe, _Type),
1882 parse_header_value(Field, Codes, Prolog0),
1883 !,
1884 Prolog = Prolog0.
1885field_to_prolog(_, Codes, Atom) :-
1886 atom_codes(Atom, Codes).
1887
1892
(content_length, ValueChars, ContentLength) :-
1894 number_codes(ContentLength, ValueChars).
1895parse_header_value(status, ValueChars, Code) :-
1896 ( phrase(" ", L, _),
1897 append(Pre, L, ValueChars)
1898 -> number_codes(Code, Pre)
1899 ; number_codes(Code, ValueChars)
1900 ).
1901parse_header_value(cookie, ValueChars, Cookies) :-
1902 debug(cookie, 'Cookie: ~s', [ValueChars]),
1903 phrase(cookies(Cookies), ValueChars).
1904parse_header_value(set_cookie, ValueChars, SetCookie) :-
1905 debug(cookie, 'SetCookie: ~s', [ValueChars]),
1906 phrase(set_cookie(SetCookie), ValueChars).
1907parse_header_value(host, ValueChars, Host) :-
1908 ( append(HostChars, [0':|PortChars], ValueChars),
1909 catch(number_codes(Port, PortChars), _, fail)
1910 -> atom_codes(HostName, HostChars),
1911 Host = HostName:Port
1912 ; atom_codes(Host, ValueChars)
1913 ).
1914parse_header_value(range, ValueChars, Range) :-
1915 phrase(range(Range), ValueChars).
1916parse_header_value(accept, ValueChars, Media) :-
1917 parse_accept(ValueChars, Media).
1918parse_header_value(content_disposition, ValueChars, Disposition) :-
1919 phrase(content_disposition(Disposition), ValueChars).
1920parse_header_value(content_type, ValueChars, Type) :-
1921 phrase(parse_content_type(Type), ValueChars).
1922
1924
1925field_value(_, set_cookie(Name, Value, Options)) -->
1926 !,
1927 atom(Name), "=", atom(Value),
1928 value_options(Options, cookie).
1929field_value(_, disposition(Disposition, Options)) -->
1930 !,
1931 atom(Disposition), value_options(Options, disposition).
1932field_value(www_authenticate, Auth) -->
1933 auth_field_value(Auth).
1934field_value(_, Atomic) -->
1935 atom(Atomic).
1936
1940
1941auth_field_value(negotiate(Data)) -->
1942 "Negotiate ",
1943 { base64(Data, DataBase64),
1944 atom_codes(DataBase64, Codes)
1945 },
1946 string(Codes).
1947auth_field_value(negotiate) -->
1948 "Negotiate".
1949auth_field_value(basic) -->
1950 !,
1951 "Basic".
1952auth_field_value(basic(Realm)) -->
1953 "Basic Realm=\"", atom(Realm), "\"".
1954auth_field_value(digest) -->
1955 !,
1956 "Digest".
1957auth_field_value(digest(Details)) -->
1958 "Digest ", atom(Details).
1959
1966
1967value_options([], _) --> [].
1968value_options([H|T], Field) -->
1969 "; ", value_option(H, Field),
1970 value_options(T, Field).
1971
1972value_option(secure=true, cookie) -->
1973 !,
1974 "secure".
1975value_option(Name=Value, Type) -->
1976 { string_option(Name, Type) },
1977 !,
1978 atom(Name), "=",
1979 qstring(Value).
1980value_option(Name=Value, Type) -->
1981 { token_option(Name, Type) },
1982 !,
1983 atom(Name), "=", atom(Value).
1984value_option(Name=Value, _Type) -->
1985 atom(Name), "=",
1986 option_value(Value).
1987
1988string_option(filename, disposition).
1989
1990token_option(path, cookie).
1991
1992option_value(Value) -->
1993 { number(Value) },
1994 !,
1995 number(Value).
1996option_value(Value) -->
1997 { ( atom(Value)
1998 -> true
1999 ; string(Value)
2000 ),
2001 forall(string_code(_, Value, C),
2002 token_char(C))
2003 },
2004 !,
2005 atom(Value).
2006option_value(Atomic) -->
2007 qstring(Atomic).
2008
2009qstring(Atomic) -->
2010 { string_codes(Atomic, Codes) },
2011 "\"",
2012 qstring_codes(Codes),
2013 "\"".
2014
2015qstring_codes([]) --> [].
2016qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
2017
2018qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
2019qstring_code(C) --> [C].
2020
2021qstring_esc(0'").
2022qstring_esc(C) :- ctl(C).
2023
2024
2025 2028
2029:- dynamic accept_cache/2. 2030:- volatile accept_cache/2. 2031
2032parse_accept(Codes, Media) :-
2033 atom_codes(Atom, Codes),
2034 ( accept_cache(Atom, Media0)
2035 -> Media = Media0
2036 ; phrase(accept(Media0), Codes),
2037 keysort(Media0, Media1),
2038 pairs_values(Media1, Media2),
2039 assertz(accept_cache(Atom, Media2)),
2040 Media = Media2
2041 ).
2042
2046
2047accept([H|T]) -->
2048 blanks,
2049 media_range(H),
2050 blanks,
2051 ( ","
2052 -> accept(T)
2053 ; {T=[]}
2054 ).
2055
2056media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
2057 media_type(Type),
2058 blanks,
2059 ( ";"
2060 -> blanks,
2061 parameters_and_quality(TypeParams, Quality, AcceptExts)
2062 ; { TypeParams = [],
2063 Quality = 1.0,
2064 AcceptExts = []
2065 }
2066 ),
2067 { SortQuality is float(-Quality),
2068 rank_specialised(Type, TypeParams, Spec)
2069 }.
2070
2071
2075
2076content_disposition(disposition(Disposition, Options)) -->
2077 token(Disposition), blanks,
2078 value_parameters(Options).
2079
2084
2085parse_content_type(media(Type, Parameters)) -->
2086 media_type(Type), blanks,
2087 value_parameters(Parameters).
2088
2089
2097
2098rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
2099 var_or_given(Type, VT),
2100 var_or_given(SubType, VS),
2101 length(TypeParams, VP),
2102 SortVP is -VP.
2103
2104var_or_given(V, Val) :-
2105 ( var(V)
2106 -> Val = 0
2107 ; Val = -1
2108 ).
2109
2110media_type(Type/SubType) -->
2111 type(Type), "/", type(SubType).
2112
2113type(_) -->
2114 "*",
2115 !.
2116type(Type) -->
2117 token(Type).
2118
2119parameters_and_quality(Params, Quality, AcceptExts) -->
2120 token(Name),
2121 blanks, "=", blanks,
2122 ( { Name == q }
2123 -> float(Quality), blanks,
2124 value_parameters(AcceptExts),
2125 { Params = [] }
2126 ; { Params = [Name=Value|T] },
2127 parameter_value(Value),
2128 blanks,
2129 ( ";"
2130 -> blanks,
2131 parameters_and_quality(T, Quality, AcceptExts)
2132 ; { T = [],
2133 Quality = 1.0,
2134 AcceptExts = []
2135 }
2136 )
2137 ).
2138
2143
2144value_parameters([H|T]) -->
2145 ";",
2146 !,
2147 blanks, token(Name), blanks,
2148 ( "="
2149 -> blanks,
2150 ( token(Value)
2151 -> []
2152 ; quoted_string(Value)
2153 ),
2154 { H = (Name=Value) }
2155 ; { H = Name }
2156 ),
2157 blanks,
2158 value_parameters(T).
2159value_parameters([]) -->
2160 [].
2161
2162parameter_value(Value) --> token(Value), !.
2163parameter_value(Value) --> quoted_string(Value).
2164
2165
2169
2170token(Name) -->
2171 token_char(C1),
2172 token_chars(Cs),
2173 { atom_codes(Name, [C1|Cs]) }.
2174
2175token_chars([H|T]) -->
2176 token_char(H),
2177 !,
2178 token_chars(T).
2179token_chars([]) --> [].
2180
2181token_char(C) :-
2182 \+ ctl(C),
2183 \+ separator_code(C).
2184
2185ctl(C) :- between(0,31,C), !.
2186ctl(127).
2187
2188separator_code(0'().
2189separator_code(0')).
2190separator_code(0'<).
2191separator_code(0'>).
2192separator_code(0'@).
2193separator_code(0',).
2194separator_code(0';).
2195separator_code(0':).
2196separator_code(0'\\).
2197separator_code(0'").
2198separator_code(0'/).
2199separator_code(0'[).
2200separator_code(0']).
2201separator_code(0'?).
2202separator_code(0'=).
2203separator_code(0'{).
2204separator_code(0'}).
2205separator_code(0'\s).
2206separator_code(0'\t).
2207
2208term_expansion(token_char(x) --> [x], Clauses) :-
2209 findall((token_char(C)-->[C]),
2210 ( between(0, 255, C),
2211 token_char(C)
2212 ),
2213 Clauses).
2214
2215token_char(x) --> [x].
2216
2220
2221quoted_string(Text) -->
2222 "\"",
2223 quoted_text(Codes),
2224 { atom_codes(Text, Codes) }.
2225
2226quoted_text([]) -->
2227 "\"",
2228 !.
2229quoted_text([H|T]) -->
2230 "\\", !, [H],
2231 quoted_text(T).
2232quoted_text([H|T]) -->
2233 [H],
2234 !,
2235 quoted_text(T).
2236
2237
2245
([], _) --> [].
2247header_fields([content_length(CLen)|T], CLen) -->
2248 !,
2249 ( { var(CLen) }
2250 -> ""
2251 ; header_field(content_length, CLen)
2252 ),
2253 header_fields(T, CLen). 2254header_fields([status(_)|T], CLen) --> 2255 !,
2256 header_fields(T, CLen).
2257header_fields([H|T], CLen) -->
2258 { H =.. [Name, Value] },
2259 header_field(Name, Value),
2260 header_fields(T, CLen).
2261
2262
2276
2277:- public
2278 field_name//1. 2279
2280field_name(Name) -->
2281 { var(Name) },
2282 !,
2283 rd_field_chars(Chars),
2284 { atom_codes(Name, Chars) }.
2285field_name(mime_version) -->
2286 !,
2287 "MIME-Version".
2288field_name(www_authenticate) -->
2289 !,
2290 "WWW-Authenticate".
2291field_name(Name) -->
2292 { atom_codes(Name, Chars) },
2293 wr_field_chars(Chars).
2294
2295rd_field_chars_no_fold([C|T]) -->
2296 [C],
2297 { rd_field_char(C, _) },
2298 !,
2299 rd_field_chars_no_fold(T).
2300rd_field_chars_no_fold([]) -->
2301 [].
2302
2303rd_field_chars([C0|T]) -->
2304 [C],
2305 { rd_field_char(C, C0) },
2306 !,
2307 rd_field_chars(T).
2308rd_field_chars([]) -->
2309 [].
2310
2314
2315separators("()<>@,;:\\\"/[]?={} \t").
2316
2317term_expansion(rd_field_char('expand me',_), Clauses) :-
2318
2319 Clauses = [ rd_field_char(0'-, 0'_)
2320 | Cls
2321 ],
2322 separators(SepString),
2323 string_codes(SepString, Seps),
2324 findall(rd_field_char(In, Out),
2325 ( between(32, 127, In),
2326 \+ memberchk(In, Seps),
2327 In \== 0'-, 2328 code_type(Out, to_lower(In))),
2329 Cls).
2330
2331rd_field_char('expand me', _). 2332
2333wr_field_chars([C|T]) -->
2334 !,
2335 { code_type(C, to_lower(U)) },
2336 [U],
2337 wr_field_chars2(T).
2338wr_field_chars([]) -->
2339 [].
2340
2341wr_field_chars2([]) --> [].
2342wr_field_chars2([C|T]) --> 2343 ( { C == 0'_ }
2344 -> "-",
2345 wr_field_chars(T)
2346 ; [C],
2347 wr_field_chars2(T)
2348 ).
2349
2353
2354now -->
2355 { get_time(Time)
2356 },
2357 rfc_date(Time).
2358
2363
2364rfc_date(Time, String, Tail) :-
2365 stamp_date_time(Time, Date, 'UTC'),
2366 format_time(codes(String, Tail),
2367 '%a, %d %b %Y %T GMT',
2368 Date, posix).
2369
2373
2374http_timestamp(Time, Atom) :-
2375 stamp_date_time(Time, Date, 'UTC'),
2376 format_time(atom(Atom),
2377 '%a, %d %b %Y %T GMT',
2378 Date, posix).
2379
2380
2381 2384
2385request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
2386 method(Method),
2387 blanks,
2388 nonblanks(Query),
2389 { atom_codes(ReqURI, Query),
2390 request_uri_parts(ReqURI, Header, Rest)
2391 },
2392 request_header(Fd, Rest),
2393 !.
2394request(Fd, [unknown(What)|Header]) -->
2395 string(What),
2396 eos,
2397 !,
2398 { http_read_header(Fd, Header)
2399 -> true
2400 ; Header = []
2401 }.
2402
2403method(get) --> "GET", !.
2404method(put) --> "PUT", !.
2405method(head) --> "HEAD", !.
2406method(post) --> "POST", !.
2407method(delete) --> "DELETE", !.
2408method(patch) --> "PATCH", !.
2409method(options) --> "OPTIONS", !.
2410method(trace) --> "TRACE", !.
2411
2423
2424request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
2425 uri_components(ReqURI, Components),
2426 uri_data(path, Components, PathText),
2427 uri_encoded(path, Path, PathText),
2428 phrase(uri_parts(Components), Parts, Rest).
2429
2430uri_parts(Components) -->
2431 uri_search(Components),
2432 uri_fragment(Components).
2433
2434uri_search(Components) -->
2435 { uri_data(search, Components, Search),
2436 nonvar(Search),
2437 catch(uri_query_components(Search, Query),
2438 error(syntax_error(_),_),
2439 fail)
2440 },
2441 !,
2442 [ search(Query) ].
2443uri_search(_) --> [].
2444
2445uri_fragment(Components) -->
2446 { uri_data(fragment, Components, String),
2447 nonvar(String),
2448 !,
2449 uri_encoded(fragment, Fragment, String)
2450 },
2451 [ fragment(Fragment) ].
2452uri_fragment(_) --> [].
2453
2458
(_, []) --> 2460 blanks,
2461 eos,
2462 !.
2463request_header(Fd, [http_version(Version)|Header]) -->
2464 http_version(Version),
2465 blanks,
2466 eos,
2467 !,
2468 { Version = 1-_
2469 -> http_read_header(Fd, Header)
2470 ; Header = []
2471 }.
2472
2473http_version(Version) -->
2474 blanks,
2475 "HTTP/",
2476 http_version_number(Version).
2477
2478http_version_number(Major-Minor) -->
2479 integer(Major),
2480 ".",
2481 integer(Minor).
2482
2483
2484 2487
2491
2492cookies([Name=Value|T]) -->
2493 blanks,
2494 cookie(Name, Value),
2495 !,
2496 blanks,
2497 ( ";"
2498 -> cookies(T)
2499 ; { T = [] }
2500 ).
2501cookies(List) -->
2502 string(Skipped),
2503 ";",
2504 !,
2505 { print_message(warning, http(skipped_cookie(Skipped))) },
2506 cookies(List).
2507cookies([]) -->
2508 blanks.
2509
2510cookie(Name, Value) -->
2511 cookie_name(Name),
2512 blanks, "=", blanks,
2513 cookie_value(Value).
2514
2515cookie_name(Name) -->
2516 { var(Name) },
2517 !,
2518 rd_field_chars_no_fold(Chars),
2519 { atom_codes(Name, Chars) }.
2520
2521cookie_value(Value) -->
2522 quoted_string(Value),
2523 !.
2524cookie_value(Value) -->
2525 chars_to_semicolon_or_blank(Chars),
2526 { atom_codes(Value, Chars)
2527 }.
2528
2529chars_to_semicolon_or_blank([]), ";" -->
2530 ";",
2531 !.
2532chars_to_semicolon_or_blank([]) -->
2533 " ",
2534 blanks,
2535 eos,
2536 !.
2537chars_to_semicolon_or_blank([H|T]) -->
2538 [H],
2539 !,
2540 chars_to_semicolon_or_blank(T).
2541chars_to_semicolon_or_blank([]) -->
2542 [].
2543
2544set_cookie(set_cookie(Name, Value, Options)) -->
2545 ws,
2546 cookie(Name, Value),
2547 cookie_options(Options).
2548
2549cookie_options([H|T]) -->
2550 ws,
2551 ";",
2552 ws,
2553 cookie_option(H),
2554 !,
2555 cookie_options(T).
2556cookie_options([]) -->
2557 ws.
2558
2559ws --> " ", !, ws.
2560ws --> [].
2561
2562
2571
2572cookie_option(Name=Value) -->
2573 rd_field_chars(NameChars), ws,
2574 { atom_codes(Name, NameChars) },
2575 ( "="
2576 -> ws,
2577 chars_to_semicolon(ValueChars),
2578 { atom_codes(Value, ValueChars)
2579 }
2580 ; { Value = true }
2581 ).
2582
2583chars_to_semicolon([H|T]) -->
2584 [H],
2585 { H \== 32, H \== 0'; },
2586 !,
2587 chars_to_semicolon(T).
2588chars_to_semicolon([]), ";" -->
2589 ws, ";",
2590 !.
2591chars_to_semicolon([H|T]) -->
2592 [H],
2593 chars_to_semicolon(T).
2594chars_to_semicolon([]) -->
2595 [].
2596
2604
2605range(bytes(From, To)) -->
2606 "bytes", whites, "=", whites, integer(From), "-",
2607 ( integer(To)
2608 -> ""
2609 ; { To = end }
2610 ).
2611
2612
2613 2616
2631
2632reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
2633 http_version(HttpVersion),
2634 blanks,
2635 ( status_number(Status, Code)
2636 -> []
2637 ; integer(Status)
2638 ),
2639 blanks,
2640 string(CommentCodes),
2641 blanks_to_nl,
2642 !,
2643 blanks,
2644 { atom_codes(Comment, CommentCodes),
2645 http_read_header(Fd, Header)
2646 }.
2647
2648
2649 2652
2658
(Fd, Header) :-
2660 read_header_data(Fd, Text),
2661 http_parse_header(Text, Header).
2662
(Fd, Header) :-
2664 read_line_to_codes(Fd, Header, Tail),
2665 read_header_data(Header, Fd, Tail),
2666 debug(http(header), 'Header = ~n~s~n', [Header]).
2667
([0'\r,0'\n], _, _) :- !.
2669read_header_data([0'\n], _, _) :- !.
2670read_header_data([], _, _) :- !.
2671read_header_data(_, Fd, Tail) :-
2672 read_line_to_codes(Fd, Tail, NewTail),
2673 read_header_data(Tail, Fd, NewTail).
2674
2681
(Text, Header) :-
2683 phrase(header(Header), Text),
2684 debug(http(header), 'Field: ~p', [Header]).
2685
(List) -->
2687 header_field(Name, Value),
2688 !,
2689 { mkfield(Name, Value, List, Tail)
2690 },
2691 blanks,
2692 header(Tail).
2693header([]) -->
2694 blanks,
2695 eos,
2696 !.
2697header(_) -->
2698 string(S), blanks_to_nl,
2699 !,
2700 { string_codes(Line, S),
2701 syntax_error(http_parameter(Line))
2702 }.
2703
2715
2716:- multifile
2717 http:http_address//0. 2718
2719address -->
2720 http:http_address,
2721 !.
2722address -->
2723 { gethostname(Host) },
2724 html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
2725 ' httpd at ', Host
2726 ])).
2727
2728mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
2729mkfield(Name, Value, [Att|Tail], Tail) :-
2730 Att =.. [Name, Value].
2731
2737
2767
2768
2769 2772
2773:- multifile
2774 prolog:message//1,
2775 prolog:error_message//1. 2776
2777prolog:error_message(http_write_short(Data, Sent)) -->
2778 data(Data),
2779 [ ': remote hangup after ~D bytes'-[Sent] ].
2780prolog:error_message(syntax_error(http_request(Request))) -->
2781 [ 'Illegal HTTP request: ~s'-[Request] ].
2782prolog:error_message(syntax_error(http_parameter(Line))) -->
2783 [ 'Illegal HTTP parameter: ~s'-[Line] ].
2784
2785prolog:message(http(skipped_cookie(S))) -->
2786 [ 'Skipped illegal cookie: ~s'-[S] ].
2787
2788data(bytes(MimeType, _Bytes)) -->
2789 !,
2790 [ 'bytes(~p, ...)'-[MimeType] ].
2791data(Data) -->
2792 [ '~p'-[Data] ]