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:- use_module(library(readutil)). 64:- use_module(library(debug)). 65:- use_module(library(error)). 66:- use_module(library(option)). 67:- use_module(library(lists)). 68:- use_module(library(url)). 69:- use_module(library(uri)). 70:- use_module(library(memfile)). 71:- use_module(library(settings)). 72:- use_module(library(error)). 73:- use_module(library(pairs)). 74:- use_module(library(socket)). 75:- use_module(library(dcg/basics)). 76:- use_module(html_write). 77:- use_module(http_exception). 78:- use_module(mimetype). 79:- use_module(mimepack). 80
81:- multifile
82 http:status_page/3, 83 http:status_reply/3, 84 http:serialize_reply/2, 85 http:post_data_hook/3, 86 http:mime_type_encoding/2. 87
89
90:- setting(http:chunked_transfer, oneof([never,on_request,if_possible]),
91 on_request, 'When to use Transfer-Encoding: Chunked'). 92
93
100
101:- discontiguous
102 term_expansion/2. 103
104
105 108
114
115http_read_request(In, Request) :-
116 catch(read_line_to_codes(In, Codes), E, true),
117 ( var(E)
118 -> ( Codes == end_of_file
119 -> debug(http(header), 'end-of-file', []),
120 Request = end_of_file
121 ; debug(http(header), 'First line: ~s', [Codes]),
122 Request = [input(In)|Request1],
123 phrase(request(In, Request1), Codes),
124 ( Request1 = [unknown(Text)|_]
125 -> string_codes(S, Text),
126 syntax_error(http_request(S))
127 ; true
128 )
129 )
130 ; ( debugging(http(request))
131 -> message_to_string(E, Msg),
132 debug(http(request), "Exception reading 1st line: ~s", [Msg])
133 ; true
134 ),
135 Request = end_of_file
136 ).
137
138
143
(In, [input(In)|Reply]) :-
145 read_line_to_codes(In, Codes),
146 ( Codes == end_of_file
147 -> debug(http(header), 'end-of-file', []),
148 throw(error(syntax(http_reply_header, end_of_file), _))
149 ; debug(http(header), 'First line: ~s~n', [Codes]),
150 ( phrase(reply(In, Reply), Codes)
151 -> true
152 ; atom_codes(Header, Codes),
153 syntax_error(http_reply_header(Header))
154 )
155 ).
156
157
158 161
208
209http_reply(What, Out) :-
210 http_reply(What, Out, [connection(close)], _).
211
212http_reply(Data, Out, HdrExtra) :-
213 http_reply(Data, Out, HdrExtra, _Code).
214
215http_reply(Data, Out, HdrExtra, Code) :-
216 http_reply(Data, Out, HdrExtra, [], Code).
217
218http_reply(Data, Out, HdrExtra, Context, Code) :-
219 http_reply(Data, Out, HdrExtra, Context, [method(get)], Code).
220
221http_reply(Data, Out, HdrExtra, _Context, Request, Code) :-
222 byte_count(Out, C0),
223 memberchk(method(Method), Request),
224 catch(http_reply_data(Data, Out, HdrExtra, Method, Code), E, true),
225 !,
226 ( var(E)
227 -> true
228 ; E = error(io_error(write, _), _)
229 -> byte_count(Out, C1),
230 Sent is C1 - C0,
231 throw(error(http_write_short(Data, Sent), _))
232 ; E = error(timeout_error(write, _), _)
233 -> throw(E)
234 ; map_exception_to_http_status(E, Status, NewHdr, NewContext),
235 http_status_reply(Status, Out, NewHdr, NewContext, Request, Code)
236 ).
237http_reply(Status, Out, HdrExtra, Context, Request, Code) :-
238 http_status_reply(Status, Out, HdrExtra, Context, Request, Code).
239
240:- meta_predicate
241 if_no_head(0, +). 242
249
250http_reply_data(Data, Out, HdrExtra, Method, Code) :-
251 http_reply_data_(Data, Out, HdrExtra, Method, Code),
252 flush_output(Out).
253
254http_reply_data_(html(HTML), Out, HdrExtra, Method, Code) :-
255 !,
256 phrase(reply_header(html(HTML), HdrExtra, Code), Header),
257 format(Out, '~s', [Header]),
258 if_no_head(print_html(Out, HTML), Method).
259http_reply_data_(file(Type, File), Out, HdrExtra, Method, Code) :-
260 !,
261 phrase(reply_header(file(Type, File), HdrExtra, Code), Header),
262 reply_file(Out, File, Header, Method).
263http_reply_data_(gzip_file(Type, File), Out, HdrExtra, Method, Code) :-
264 !,
265 phrase(reply_header(gzip_file(Type, File), HdrExtra, Code), Header),
266 reply_file(Out, File, Header, Method).
267http_reply_data_(file(Type, File, Range), Out, HdrExtra, Method, Code) :-
268 !,
269 phrase(reply_header(file(Type, File, Range), HdrExtra, Code), Header),
270 reply_file_range(Out, File, Header, Range, Method).
271http_reply_data_(tmp_file(Type, File), Out, HdrExtra, Method, Code) :-
272 !,
273 phrase(reply_header(tmp_file(Type, File), HdrExtra, Code), Header),
274 reply_file(Out, File, Header, Method).
275http_reply_data_(bytes(Type, Bytes), Out, HdrExtra, Method, Code) :-
276 !,
277 phrase(reply_header(bytes(Type, Bytes), HdrExtra, Code), Header),
278 format(Out, '~s', [Header]),
279 if_no_head(format(Out, '~s', [Bytes]), Method).
280http_reply_data_(stream(In, Len), Out, HdrExtra, Method, Code) :-
281 !,
282 phrase(reply_header(cgi_data(Len), HdrExtra, Code), Header),
283 copy_stream(Out, In, Header, Method, 0, end).
284http_reply_data_(cgi_stream(In, Len), Out, HdrExtra, Method, Code) :-
285 !,
286 http_read_header(In, CgiHeader),
287 seek(In, 0, current, Pos),
288 Size is Len - Pos,
289 http_join_headers(HdrExtra, CgiHeader, Hdr2),
290 phrase(reply_header(cgi_data(Size), Hdr2, Code), Header),
291 copy_stream(Out, In, Header, Method, 0, end).
292
293if_no_head(_, head) :-
294 !.
295if_no_head(Goal, _) :-
296 call(Goal).
297
298reply_file(Out, _File, Header, head) :-
299 !,
300 format(Out, '~s', [Header]).
301reply_file(Out, File, Header, _) :-
302 setup_call_cleanup(
303 open(File, read, In, [type(binary)]),
304 copy_stream(Out, In, Header, 0, end),
305 close(In)).
306
307reply_file_range(Out, _File, Header, _Range, head) :-
308 !,
309 format(Out, '~s', [Header]).
310reply_file_range(Out, File, Header, bytes(From, To), _) :-
311 setup_call_cleanup(
312 open(File, read, In, [type(binary)]),
313 copy_stream(Out, In, Header, From, To),
314 close(In)).
315
316copy_stream(Out, _, Header, head, _, _) :-
317 !,
318 format(Out, '~s', [Header]).
319copy_stream(Out, In, Header, _, From, To) :-
320 copy_stream(Out, In, Header, From, To).
321
322copy_stream(Out, In, Header, From, To) :-
323 ( From == 0
324 -> true
325 ; seek(In, From, bof, _)
326 ),
327 peek_byte(In, _),
328 format(Out, '~s', [Header]),
329 ( To == end
330 -> copy_stream_data(In, Out)
331 ; Len is To - From,
332 copy_stream_data(In, Out, Len)
333 ).
334
335
366
367http_status_reply(Status, Out, Options) :-
368 _{header:HdrExtra, context:Context, code:Code, method:Method} :< Options,
369 http_status_reply(Status, Out, HdrExtra, Context, [method(Method)], Code).
370
371http_status_reply(Status, Out, HdrExtra, Code) :-
372 http_status_reply(Status, Out, HdrExtra, [], Code).
373
374http_status_reply(Status, Out, HdrExtra, Context, Code) :-
375 http_status_reply(Status, Out, HdrExtra, Context, [method(get)], Code).
376
377http_status_reply(Status, Out, HdrExtra, Context, Request, Code) :-
378 option(method(Method), Request, get),
379 parsed_accept(Request, Accept),
380 status_reply_flush(Status, Out,
381 _{ context: Context,
382 method: Method,
383 code: Code,
384 accept: Accept,
385 header: HdrExtra
386 }).
387
388parsed_accept(Request, Accept) :-
389 memberchk(accept(Accept0), Request),
390 http_parse_header_value(accept, Accept0, Accept1),
391 !,
392 Accept = Accept1.
393parsed_accept(_, [ media(text/html, [], 0.1, []),
394 media(_, [], 0.01, [])
395 ]).
396
397status_reply_flush(Status, Out, Options) :-
398 status_reply(Status, Out, Options),
399 !,
400 flush_output(Out).
401
412
414status_reply(no_content, Out, Options) :-
415 !,
416 phrase(reply_header(status(no_content), Options), Header),
417 format(Out, '~s', [Header]).
418status_reply(switching_protocols(_Goal,SwitchOptions), Out, Options) :-
419 !,
420 ( option(headers(Extra1), SwitchOptions)
421 -> true
422 ; option(header(Extra1), SwitchOptions, [])
423 ),
424 http_join_headers(Options.header, Extra1, HdrExtra),
425 phrase(reply_header(status(switching_protocols),
426 Options.put(header,HdrExtra)), Header),
427 format(Out, '~s', [Header]).
428status_reply(authorise(basic, ''), Out, Options) :-
429 !,
430 status_reply(authorise(basic), Out, Options).
431status_reply(authorise(basic, Realm), Out, Options) :-
432 !,
433 status_reply(authorise(basic(Realm)), Out, Options).
434status_reply(not_modified, Out, Options) :-
435 !,
436 phrase(reply_header(status(not_modified), Options), Header),
437 format(Out, '~s', [Header]).
439status_reply(busy, Out, Options) :-
440 status_reply(service_unavailable(busy), Out, Options).
441status_reply(unavailable(Why), Out, Options) :-
442 status_reply(service_unavailable(Why), Out, Options).
443status_reply(resource_error(Why), Out, Options) :-
444 status_reply(service_unavailable(Why), Out, Options).
446status_reply(Status, Out, Options) :-
447 status_has_content(Status),
448 status_page_hook(Status, Reply, Options),
449 serialize_body(Reply, Body),
450 Status =.. List,
451 append(List, [Body], ExList),
452 ExStatus =.. ExList,
453 phrase(reply_header(ExStatus, Options), Header),
454 format(Out, '~s', [Header]),
455 reply_status_body(Out, Body, Options).
456
461
462status_has_content(created(_Location)).
463status_has_content(moved(_To)).
464status_has_content(moved_temporary(_To)).
465status_has_content(see_other(_To)).
466status_has_content(bad_request(_ErrorTerm)).
467status_has_content(authorise(_Method)).
468status_has_content(forbidden(_URL)).
469status_has_content(not_found(_URL)).
470status_has_content(method_not_allowed(_Method, _URL)).
471status_has_content(not_acceptable(_Why)).
472status_has_content(server_error(_ErrorTerm)).
473status_has_content(service_unavailable(_Why)).
474
483
484serialize_body(Reply, Body) :-
485 http:serialize_reply(Reply, Body),
486 !.
487serialize_body(html_tokens(Tokens), body(text/html, utf8, Content)) :-
488 !,
489 with_output_to(string(Content), print_html(Tokens)).
490serialize_body(Reply, Reply) :-
491 Reply = body(_,_,_),
492 !.
493serialize_body(Reply, _) :-
494 domain_error(http_reply_body, Reply).
495
496reply_status_body(_, _, Options) :-
497 Options.method == head,
498 !.
499reply_status_body(Out, body(_Type, Encoding, Content), _Options) :-
500 ( Encoding == octet
501 -> format(Out, '~s', [Content])
502 ; setup_call_cleanup(
503 set_stream(Out, encoding(Encoding)),
504 format(Out, '~s', [Content]),
505 set_stream(Out, encoding(octet)))
506 ).
507
517
532
533status_page_hook(Term, Reply, Options) :-
534 Context = Options.context,
535 functor(Term, Name, _),
536 status_number_fact(Name, Code),
537 ( Options.code = Code,
538 http:status_reply(Term, Reply, Options)
539 ; http:status_page(Term, Context, HTML),
540 Reply = html_tokens(HTML)
541 ; http:status_page(Code, Context, HTML), 542 Reply = html_tokens(HTML)
543 ),
544 !.
545status_page_hook(created(Location), html_tokens(HTML), _Options) :-
546 phrase(page([ title('201 Created')
547 ],
548 [ h1('Created'),
549 p(['The document was created ',
550 a(href(Location), ' Here')
551 ]),
552 \address
553 ]),
554 HTML).
555status_page_hook(moved(To), html_tokens(HTML), _Options) :-
556 phrase(page([ title('301 Moved Permanently')
557 ],
558 [ h1('Moved Permanently'),
559 p(['The document has moved ',
560 a(href(To), ' Here')
561 ]),
562 \address
563 ]),
564 HTML).
565status_page_hook(moved_temporary(To), html_tokens(HTML), _Options) :-
566 phrase(page([ title('302 Moved Temporary')
567 ],
568 [ h1('Moved Temporary'),
569 p(['The document is currently ',
570 a(href(To), ' Here')
571 ]),
572 \address
573 ]),
574 HTML).
575status_page_hook(see_other(To), html_tokens(HTML), _Options) :-
576 phrase(page([ title('303 See Other')
577 ],
578 [ h1('See Other'),
579 p(['See other document ',
580 a(href(To), ' Here')
581 ]),
582 \address
583 ]),
584 HTML).
585status_page_hook(bad_request(ErrorTerm), html_tokens(HTML), _Options) :-
586 '$messages':translate_message(ErrorTerm, Lines, []),
587 phrase(page([ title('400 Bad Request')
588 ],
589 [ h1('Bad Request'),
590 p(\html_message_lines(Lines)),
591 \address
592 ]),
593 HTML).
594status_page_hook(authorise(_Method), html_tokens(HTML), _Options):-
595 phrase(page([ title('401 Authorization Required')
596 ],
597 [ h1('Authorization Required'),
598 p(['This server could not verify that you ',
599 'are authorized to access the document ',
600 'requested. Either you supplied the wrong ',
601 'credentials (e.g., bad password), or your ',
602 'browser doesn\'t understand how to supply ',
603 'the credentials required.'
604 ]),
605 \address
606 ]),
607 HTML).
608status_page_hook(forbidden(URL), html_tokens(HTML), _Options) :-
609 phrase(page([ title('403 Forbidden')
610 ],
611 [ h1('Forbidden'),
612 p(['You don\'t have permission to access ', URL,
613 ' on this server'
614 ]),
615 \address
616 ]),
617 HTML).
618status_page_hook(not_found(URL), html_tokens(HTML), _Options) :-
619 phrase(page([ title('404 Not Found')
620 ],
621 [ h1('Not Found'),
622 p(['The requested URL ', tt(URL),
623 ' was not found on this server'
624 ]),
625 \address
626 ]),
627 HTML).
628status_page_hook(method_not_allowed(Method,URL), html_tokens(HTML), _Options) :-
629 upcase_atom(Method, UMethod),
630 phrase(page([ title('405 Method not allowed')
631 ],
632 [ h1('Method not allowed'),
633 p(['The requested URL ', tt(URL),
634 ' does not support method ', tt(UMethod), '.'
635 ]),
636 \address
637 ]),
638 HTML).
639status_page_hook(not_acceptable(WhyHTML), html_tokens(HTML), _Options) :-
640 phrase(page([ title('406 Not Acceptable')
641 ],
642 [ h1('Not Acceptable'),
643 WhyHTML,
644 \address
645 ]),
646 HTML).
647status_page_hook(server_error(ErrorTerm), html_tokens(HTML), _Options) :-
648 '$messages':translate_message(ErrorTerm, Lines, []),
649 phrase(page([ title('500 Internal server error')
650 ],
651 [ h1('Internal server error'),
652 p(\html_message_lines(Lines)),
653 \address
654 ]),
655 HTML).
656status_page_hook(service_unavailable(Why), html_tokens(HTML), _Options) :-
657 phrase(page([ title('503 Service Unavailable')
658 ],
659 [ h1('Service Unavailable'),
660 \unavailable(Why),
661 \address
662 ]),
663 HTML).
664
665unavailable(busy) -->
666 html(p(['The server is temporarily out of resources, ',
667 'please try again later'])).
668unavailable(error(Formal,Context)) -->
669 { '$messages':translate_message(error(Formal,Context), Lines, []) },
670 html_message_lines(Lines).
671unavailable(HTML) -->
672 html(HTML).
673
674html_message_lines([]) -->
675 [].
676html_message_lines([nl|T]) -->
677 !,
678 html([br([])]),
679 html_message_lines(T).
680html_message_lines([flush]) -->
681 [].
682html_message_lines([Fmt-Args|T]) -->
683 !,
684 { format(string(S), Fmt, Args)
685 },
686 html([S]),
687 html_message_lines(T).
688html_message_lines([Fmt|T]) -->
689 !,
690 { format(string(S), Fmt, [])
691 },
692 html([S]),
693 html_message_lines(T).
694
699
([], H, H).
701http_join_headers([H|T], Hdr0, Hdr) :-
702 functor(H, N, A),
703 functor(H2, N, A),
704 member(H2, Hdr0),
705 !,
706 http_join_headers(T, Hdr0, Hdr).
707http_join_headers([H|T], Hdr0, [H|Hdr]) :-
708 http_join_headers(T, Hdr0, Hdr).
709
710
719
720http_update_encoding(Header0, utf8, [content_type(Type)|Header]) :-
721 select(content_type(Type0), Header0, Header),
722 sub_atom(Type0, 0, _, _, 'text/'),
723 !,
724 ( sub_atom(Type0, S, _, _, ';')
725 -> sub_atom(Type0, 0, S, _, B)
726 ; B = Type0
727 ),
728 atom_concat(B, '; charset=UTF-8', Type).
729http_update_encoding(Header, Encoding, Header) :-
730 memberchk(content_type(Type), Header),
731 ( ( sub_atom(Type, _, _, _, 'UTF-8')
732 ; sub_atom(Type, _, _, _, 'utf-8')
733 )
734 -> Encoding = utf8
735 ; http:mime_type_encoding(Type, Encoding)
736 -> true
737 ; mime_type_encoding(Type, Encoding)
738 ).
739http_update_encoding(Header, octet, Header).
740
745
746mime_type_encoding('application/json', utf8).
747mime_type_encoding('application/jsonrequest', utf8).
748mime_type_encoding('application/x-prolog', utf8).
749mime_type_encoding('application/n-quads', utf8).
750mime_type_encoding('application/n-triples', utf8).
751mime_type_encoding('application/sparql-query', utf8).
752mime_type_encoding('application/trig', utf8).
753
761
762
767
768http_update_connection(CgiHeader, Request, Connect,
769 [connection(Connect)|Rest]) :-
770 select(connection(CgiConn), CgiHeader, Rest),
771 !,
772 connection(Request, ReqConnection),
773 join_connection(ReqConnection, CgiConn, Connect).
774http_update_connection(CgiHeader, Request, Connect,
775 [connection(Connect)|CgiHeader]) :-
776 connection(Request, Connect).
777
778join_connection(Keep1, Keep2, Connection) :-
779 ( downcase_atom(Keep1, 'keep-alive'),
780 downcase_atom(Keep2, 'keep-alive')
781 -> Connection = 'Keep-Alive'
782 ; Connection = close
783 ).
784
785
789
790connection(Header, Close) :-
791 ( memberchk(connection(Connection), Header)
792 -> Close = Connection
793 ; memberchk(http_version(1-X), Header),
794 X >= 1
795 -> Close = 'Keep-Alive'
796 ; Close = close
797 ).
798
799
815
816http_update_transfer(Request, CgiHeader, Transfer, Header) :-
817 setting(http:chunked_transfer, When),
818 http_update_transfer(When, Request, CgiHeader, Transfer, Header).
819
820http_update_transfer(never, _, CgiHeader, none, Header) :-
821 !,
822 delete(CgiHeader, transfer_encoding(_), Header).
823http_update_transfer(_, _, CgiHeader, none, Header) :-
824 memberchk(location(_), CgiHeader),
825 !,
826 delete(CgiHeader, transfer_encoding(_), Header).
827http_update_transfer(_, Request, CgiHeader, Transfer, Header) :-
828 select(transfer_encoding(CgiTransfer), CgiHeader, Rest),
829 !,
830 transfer(Request, ReqConnection),
831 join_transfer(ReqConnection, CgiTransfer, Transfer),
832 ( Transfer == none
833 -> Header = Rest
834 ; Header = [transfer_encoding(Transfer)|Rest]
835 ).
836http_update_transfer(if_possible, Request, CgiHeader, Transfer, Header) :-
837 transfer(Request, Transfer),
838 Transfer \== none,
839 !,
840 Header = [transfer_encoding(Transfer)|CgiHeader].
841http_update_transfer(_, _, CgiHeader, none, CgiHeader).
842
843join_transfer(chunked, chunked, chunked) :- !.
844join_transfer(_, _, none).
845
846
850
851transfer(Header, Transfer) :-
852 ( memberchk(transfer_encoding(Transfer0), Header)
853 -> Transfer = Transfer0
854 ; memberchk(http_version(1-X), Header),
855 X >= 1
856 -> Transfer = chunked
857 ; Transfer = none
858 ).
859
860
866
867content_length_in_encoding(Enc, Stream, Bytes) :-
868 stream_property(Stream, position(Here)),
869 setup_call_cleanup(
870 open_null_stream(Out),
871 ( set_stream(Out, encoding(Enc)),
872 catch(copy_stream_data(Stream, Out), _, fail),
873 flush_output(Out),
874 byte_count(Out, Bytes)
875 ),
876 ( close(Out, [force(true)]),
877 set_stream_position(Stream, Here)
878 )).
879
880
881 884
975
976http_post_data(Data, Out, HdrExtra) :-
977 http:post_data_hook(Data, Out, HdrExtra),
978 !.
979http_post_data(html(HTML), Out, HdrExtra) :-
980 !,
981 phrase(post_header(html(HTML), HdrExtra), Header),
982 format(Out, '~s', [Header]),
983 print_html(Out, HTML).
984http_post_data(xml(XML), Out, HdrExtra) :-
985 !,
986 http_post_data(xml(text/xml, XML, []), Out, HdrExtra).
987http_post_data(xml(Type, XML), Out, HdrExtra) :-
988 !,
989 http_post_data(xml(Type, XML, []), Out, HdrExtra).
990http_post_data(xml(Type, XML, Options), Out, HdrExtra) :-
991 !,
992 setup_call_cleanup(
993 new_memory_file(MemFile),
994 ( setup_call_cleanup(
995 open_memory_file(MemFile, write, MemOut),
996 xml_write(MemOut, XML, Options),
997 close(MemOut)),
998 http_post_data(memory_file(Type, MemFile), Out, HdrExtra)
999 ),
1000 free_memory_file(MemFile)).
1001http_post_data(file(File), Out, HdrExtra) :-
1002 !,
1003 ( file_mime_type(File, Type)
1004 -> true
1005 ; Type = text/plain
1006 ),
1007 http_post_data(file(Type, File), Out, HdrExtra).
1008http_post_data(file(Type, File), Out, HdrExtra) :-
1009 !,
1010 phrase(post_header(file(Type, File), HdrExtra), Header),
1011 format(Out, '~s', [Header]),
1012 setup_call_cleanup(
1013 open(File, read, In, [type(binary)]),
1014 copy_stream_data(In, Out),
1015 close(In)).
1016http_post_data(memory_file(Type, Handle), Out, HdrExtra) :-
1017 !,
1018 phrase(post_header(memory_file(Type, Handle), HdrExtra), Header),
1019 format(Out, '~s', [Header]),
1020 setup_call_cleanup(
1021 open_memory_file(Handle, read, In, [encoding(octet)]),
1022 copy_stream_data(In, Out),
1023 close(In)).
1024http_post_data(codes(Codes), Out, HdrExtra) :-
1025 !,
1026 http_post_data(codes(text/plain, Codes), Out, HdrExtra).
1027http_post_data(codes(Type, Codes), Out, HdrExtra) :-
1028 !,
1029 phrase(post_header(codes(Type, Codes), HdrExtra), Header),
1030 format(Out, '~s', [Header]),
1031 setup_call_cleanup(
1032 set_stream(Out, encoding(utf8)),
1033 format(Out, '~s', [Codes]),
1034 set_stream(Out, encoding(octet))).
1035http_post_data(bytes(Type, Bytes), Out, HdrExtra) :-
1036 !,
1037 phrase(post_header(bytes(Type, Bytes), HdrExtra), Header),
1038 format(Out, '~s~s', [Header, Bytes]).
1039http_post_data(atom(Atom), Out, HdrExtra) :-
1040 !,
1041 http_post_data(atom(text/plain, Atom), Out, HdrExtra).
1042http_post_data(atom(Type, Atom), Out, HdrExtra) :-
1043 !,
1044 phrase(post_header(atom(Type, Atom), HdrExtra), Header),
1045 format(Out, '~s', [Header]),
1046 setup_call_cleanup(
1047 set_stream(Out, encoding(utf8)),
1048 write(Out, Atom),
1049 set_stream(Out, encoding(octet))).
1050http_post_data(cgi_stream(In, _Len), Out, HdrExtra) :-
1051 !,
1052 debug(obsolete, 'Obsolete 2nd argument in cgi_stream(In,Len)', []),
1053 http_post_data(cgi_stream(In), Out, HdrExtra).
1054http_post_data(cgi_stream(In), Out, HdrExtra) :-
1055 !,
1056 http_read_header(In, Header0),
1057 http_update_encoding(Header0, Encoding, Header),
1058 content_length_in_encoding(Encoding, In, Size),
1059 http_join_headers(HdrExtra, Header, Hdr2),
1060 phrase(post_header(cgi_data(Size), Hdr2), HeaderText),
1061 format(Out, '~s', [HeaderText]),
1062 setup_call_cleanup(
1063 set_stream(Out, encoding(Encoding)),
1064 copy_stream_data(In, Out),
1065 set_stream(Out, encoding(octet))).
1066http_post_data(form(Fields), Out, HdrExtra) :-
1067 !,
1068 parse_url_search(Codes, Fields),
1069 length(Codes, Size),
1070 http_join_headers(HdrExtra,
1071 [ content_type('application/x-www-form-urlencoded')
1072 ], Header),
1073 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1074 format(Out, '~s', [HeaderChars]),
1075 format(Out, '~s', [Codes]).
1076http_post_data(form_data(Data), Out, HdrExtra) :-
1077 !,
1078 setup_call_cleanup(
1079 new_memory_file(MemFile),
1080 ( setup_call_cleanup(
1081 open_memory_file(MemFile, write, MimeOut),
1082 mime_pack(Data, MimeOut, Boundary),
1083 close(MimeOut)),
1084 size_memory_file(MemFile, Size, octet),
1085 format(string(ContentType),
1086 'multipart/form-data; boundary=~w', [Boundary]),
1087 http_join_headers(HdrExtra,
1088 [ mime_version('1.0'),
1089 content_type(ContentType)
1090 ], Header),
1091 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1092 format(Out, '~s', [HeaderChars]),
1093 setup_call_cleanup(
1094 open_memory_file(MemFile, read, In, [encoding(octet)]),
1095 copy_stream_data(In, Out),
1096 close(In))
1097 ),
1098 free_memory_file(MemFile)).
1099http_post_data(List, Out, HdrExtra) :- 1100 is_list(List),
1101 !,
1102 setup_call_cleanup(
1103 new_memory_file(MemFile),
1104 ( setup_call_cleanup(
1105 open_memory_file(MemFile, write, MimeOut),
1106 mime_pack(List, MimeOut, Boundary),
1107 close(MimeOut)),
1108 size_memory_file(MemFile, Size, octet),
1109 format(string(ContentType),
1110 'multipart/mixed; boundary=~w', [Boundary]),
1111 http_join_headers(HdrExtra,
1112 [ mime_version('1.0'),
1113 content_type(ContentType)
1114 ], Header),
1115 phrase(post_header(cgi_data(Size), Header), HeaderChars),
1116 format(Out, '~s', [HeaderChars]),
1117 setup_call_cleanup(
1118 open_memory_file(MemFile, read, In, [encoding(octet)]),
1119 copy_stream_data(In, Out),
1120 close(In))
1121 ),
1122 free_memory_file(MemFile)).
1123
1128
(html(Tokens), HdrExtra) -->
1130 header_fields(HdrExtra, Len),
1131 content_length(html(Tokens), Len),
1132 content_type(text/html),
1133 "\r\n".
1134post_header(file(Type, File), HdrExtra) -->
1135 header_fields(HdrExtra, Len),
1136 content_length(file(File), Len),
1137 content_type(Type),
1138 "\r\n".
1139post_header(memory_file(Type, File), HdrExtra) -->
1140 header_fields(HdrExtra, Len),
1141 content_length(memory_file(File), Len),
1142 content_type(Type),
1143 "\r\n".
1144post_header(cgi_data(Size), HdrExtra) -->
1145 header_fields(HdrExtra, Len),
1146 content_length(Size, Len),
1147 "\r\n".
1148post_header(codes(Type, Codes), HdrExtra) -->
1149 header_fields(HdrExtra, Len),
1150 content_length(codes(Codes, utf8), Len),
1151 content_type(Type, utf8),
1152 "\r\n".
1153post_header(bytes(Type, Bytes), HdrExtra) -->
1154 header_fields(HdrExtra, Len),
1155 content_length(bytes(Bytes), Len),
1156 content_type(Type),
1157 "\r\n".
1158post_header(atom(Type, Atom), HdrExtra) -->
1159 header_fields(HdrExtra, Len),
1160 content_length(atom(Atom, utf8), Len),
1161 content_type(Type, utf8),
1162 "\r\n".
1163
1164
1165 1168
1173
(Out, What, HdrExtra) :-
1175 phrase(reply_header(What, HdrExtra, _Code), String),
1176 !,
1177 format(Out, '~s', [String]).
1178
1200
(Data, Dict) -->
1202 { _{header:HdrExtra, code:Code} :< Dict },
1203 reply_header(Data, HdrExtra, Code).
1204
(string(String), HdrExtra, Code) -->
1206 reply_header(string(text/plain, String), HdrExtra, Code).
1207reply_header(string(Type, String), HdrExtra, Code) -->
1208 vstatus(ok, Code, HdrExtra),
1209 date(now),
1210 header_fields(HdrExtra, CLen),
1211 content_length(codes(String, utf8), CLen),
1212 content_type(Type, utf8),
1213 "\r\n".
1214reply_header(bytes(Type, Bytes), HdrExtra, Code) -->
1215 vstatus(ok, Code, HdrExtra),
1216 date(now),
1217 header_fields(HdrExtra, CLen),
1218 content_length(bytes(Bytes), CLen),
1219 content_type(Type),
1220 "\r\n".
1221reply_header(html(Tokens), HdrExtra, Code) -->
1222 vstatus(ok, Code, HdrExtra),
1223 date(now),
1224 header_fields(HdrExtra, CLen),
1225 content_length(html(Tokens), CLen),
1226 content_type(text/html),
1227 "\r\n".
1228reply_header(file(Type, File), HdrExtra, Code) -->
1229 vstatus(ok, Code, HdrExtra),
1230 date(now),
1231 modified(file(File)),
1232 header_fields(HdrExtra, CLen),
1233 content_length(file(File), CLen),
1234 content_type(Type),
1235 "\r\n".
1236reply_header(gzip_file(Type, File), HdrExtra, Code) -->
1237 vstatus(ok, Code, HdrExtra),
1238 date(now),
1239 modified(file(File)),
1240 header_fields(HdrExtra, CLen),
1241 content_length(file(File), CLen),
1242 content_type(Type),
1243 content_encoding(gzip),
1244 "\r\n".
1245reply_header(file(Type, File, Range), HdrExtra, Code) -->
1246 vstatus(partial_content, Code, HdrExtra),
1247 date(now),
1248 modified(file(File)),
1249 header_fields(HdrExtra, CLen),
1250 content_length(file(File, Range), CLen),
1251 content_type(Type),
1252 "\r\n".
1253reply_header(tmp_file(Type, File), HdrExtra, Code) -->
1254 vstatus(ok, Code, HdrExtra),
1255 date(now),
1256 header_fields(HdrExtra, CLen),
1257 content_length(file(File), CLen),
1258 content_type(Type),
1259 "\r\n".
1260reply_header(cgi_data(Size), HdrExtra, Code) -->
1261 vstatus(ok, Code, HdrExtra),
1262 date(now),
1263 header_fields(HdrExtra, CLen),
1264 content_length(Size, CLen),
1265 "\r\n".
1266reply_header(chunked_data, HdrExtra, Code) -->
1267 vstatus(ok, Code, HdrExtra),
1268 date(now),
1269 header_fields(HdrExtra, _),
1270 ( {memberchk(transfer_encoding(_), HdrExtra)}
1271 -> ""
1272 ; transfer_encoding(chunked)
1273 ),
1274 "\r\n".
1276reply_header(status(Status), HdrExtra, Code) -->
1277 vstatus(Status, Code),
1278 header_fields(HdrExtra, Clen),
1279 { Clen = 0 },
1280 "\r\n".
1282reply_header(Data, HdrExtra, Code) -->
1283 { status_reply_headers(Data,
1284 body(Type, Encoding, Content),
1285 ReplyHeaders),
1286 http_join_headers(ReplyHeaders, HdrExtra, Headers),
1287 functor(Data, CodeName, _)
1288 },
1289 vstatus(CodeName, Code, Headers),
1290 date(now),
1291 header_fields(Headers, CLen),
1292 content_length(codes(Content, Encoding), CLen),
1293 content_type(Type, Encoding),
1294 "\r\n".
1295
(created(Location, Body), Body,
1297 [ location(Location) ]).
1298status_reply_headers(moved(To, Body), Body,
1299 [ location(To) ]).
1300status_reply_headers(moved_temporary(To, Body), Body,
1301 [ location(To) ]).
1302status_reply_headers(see_other(To, Body), Body,
1303 [ location(To) ]).
1304status_reply_headers(authorise(Method, Body), Body,
1305 [ www_authenticate(Method) ]).
1306status_reply_headers(not_found(_URL, Body), Body, []).
1307status_reply_headers(forbidden(_URL, Body), Body, []).
1308status_reply_headers(method_not_allowed(_Method, _URL, Body), Body, []).
1309status_reply_headers(server_error(_Error, Body), Body, []).
1310status_reply_headers(service_unavailable(_Why, Body), Body, []).
1311status_reply_headers(not_acceptable(_Why, Body), Body, []).
1312status_reply_headers(bad_request(_Error, Body), Body, []).
1313
1314
1319
1320vstatus(_Status, Code, HdrExtra) -->
1321 {memberchk(status(Code), HdrExtra)},
1322 !,
1323 vstatus(_NewStatus, Code).
1324vstatus(Status, Code, _) -->
1325 vstatus(Status, Code).
1326
1327vstatus(Status, Code) -->
1328 "HTTP/1.1 ",
1329 status_number(Status, Code),
1330 " ",
1331 status_comment(Status),
1332 "\r\n".
1333
1340
1341status_number(Status, Code) -->
1342 { var(Status) },
1343 !,
1344 integer(Code),
1345 { status_number(Status, Code) },
1346 !.
1347status_number(Status, Code) -->
1348 { status_number(Status, Code) },
1349 integer(Code).
1350
1362
1370
1371status_number(Status, Code) :-
1372 nonvar(Status),
1373 !,
1374 status_number_fact(Status, Code).
1375status_number(Status, Code) :-
1376 nonvar(Code),
1377 !,
1378 ( between(100, 599, Code)
1379 -> ( status_number_fact(Status, Code)
1380 -> true
1381 ; ClassCode is Code // 100 * 100,
1382 status_number_fact(Status, ClassCode)
1383 )
1384 ; domain_error(http_code, Code)
1385 ).
1386
1387status_number_fact(continue, 100).
1388status_number_fact(switching_protocols, 101).
1389status_number_fact(ok, 200).
1390status_number_fact(created, 201).
1391status_number_fact(accepted, 202).
1392status_number_fact(non_authoritative_info, 203).
1393status_number_fact(no_content, 204).
1394status_number_fact(reset_content, 205).
1395status_number_fact(partial_content, 206).
1396status_number_fact(multiple_choices, 300).
1397status_number_fact(moved, 301).
1398status_number_fact(moved_temporary, 302).
1399status_number_fact(see_other, 303).
1400status_number_fact(not_modified, 304).
1401status_number_fact(use_proxy, 305).
1402status_number_fact(unused, 306).
1403status_number_fact(temporary_redirect, 307).
1404status_number_fact(bad_request, 400).
1405status_number_fact(authorise, 401).
1406status_number_fact(payment_required, 402).
1407status_number_fact(forbidden, 403).
1408status_number_fact(not_found, 404).
1409status_number_fact(method_not_allowed, 405).
1410status_number_fact(not_acceptable, 406).
1411status_number_fact(request_timeout, 408).
1412status_number_fact(conflict, 409).
1413status_number_fact(gone, 410).
1414status_number_fact(length_required, 411).
1415status_number_fact(payload_too_large, 413).
1416status_number_fact(uri_too_long, 414).
1417status_number_fact(unsupported_media_type, 415).
1418status_number_fact(expectation_failed, 417).
1419status_number_fact(upgrade_required, 426).
1420status_number_fact(server_error, 500).
1421status_number_fact(not_implemented, 501).
1422status_number_fact(bad_gateway, 502).
1423status_number_fact(service_unavailable, 503).
1424status_number_fact(gateway_timeout, 504).
1425status_number_fact(http_version_not_supported, 505).
1426
1427
1431
(continue) -->
1433 "Continue".
1434status_comment(switching_protocols) -->
1435 "Switching Protocols".
1436status_comment(ok) -->
1437 "OK".
1438status_comment(created) -->
1439 "Created".
1440status_comment(accepted) -->
1441 "Accepted".
1442status_comment(non_authoritative_info) -->
1443 "Non-Authoritative Information".
1444status_comment(no_content) -->
1445 "No Content".
1446status_comment(reset_content) -->
1447 "Reset Content".
1448status_comment(created) -->
1449 "Created".
1450status_comment(partial_content) -->
1451 "Partial content".
1452status_comment(multiple_choices) -->
1453 "Multiple Choices".
1454status_comment(moved) -->
1455 "Moved Permanently".
1456status_comment(moved_temporary) -->
1457 "Moved Temporary".
1458status_comment(see_other) -->
1459 "See Other".
1460status_comment(not_modified) -->
1461 "Not Modified".
1462status_comment(use_proxy) -->
1463 "Use Proxy".
1464status_comment(unused) -->
1465 "Unused".
1466status_comment(temporary_redirect) -->
1467 "Temporary Redirect".
1468status_comment(bad_request) -->
1469 "Bad Request".
1470status_comment(authorise) -->
1471 "Authorization Required".
1472status_comment(payment_required) -->
1473 "Payment Required".
1474status_comment(forbidden) -->
1475 "Forbidden".
1476status_comment(not_found) -->
1477 "Not Found".
1478status_comment(method_not_allowed) -->
1479 "Method Not Allowed".
1480status_comment(not_acceptable) -->
1481 "Not Acceptable".
1482status_comment(request_timeout) -->
1483 "Request Timeout".
1484status_comment(conflict) -->
1485 "Conflict".
1486status_comment(gone) -->
1487 "Gone".
1488status_comment(length_required) -->
1489 "Length Required".
1490status_comment(payload_too_large) -->
1491 "Payload Too Large".
1492status_comment(uri_too_long) -->
1493 "URI Too Long".
1494status_comment(unsupported_media_type) -->
1495 "Unsupported Media Type".
1496status_comment(expectation_failed) -->
1497 "Expectation Failed".
1498status_comment(upgrade_required) -->
1499 "Upgrade Required".
1500status_comment(server_error) -->
1501 "Internal Server Error".
1502status_comment(not_implemented) -->
1503 "Not Implemented".
1504status_comment(bad_gateway) -->
1505 "Bad Gateway".
1506status_comment(service_unavailable) -->
1507 "Service Unavailable".
1508status_comment(gateway_timeout) -->
1509 "Gateway Timeout".
1510status_comment(http_version_not_supported) -->
1511 "HTTP Version Not Supported".
1512
1513date(Time) -->
1514 "Date: ",
1515 ( { Time == now }
1516 -> now
1517 ; rfc_date(Time)
1518 ),
1519 "\r\n".
1520
1521modified(file(File)) -->
1522 !,
1523 { time_file(File, Time)
1524 },
1525 modified(Time).
1526modified(Time) -->
1527 "Last-modified: ",
1528 ( { Time == now }
1529 -> now
1530 ; rfc_date(Time)
1531 ),
1532 "\r\n".
1533
1534
1541
1542content_length(file(File, bytes(From, To)), Len) -->
1543 !,
1544 { size_file(File, Size),
1545 ( To == end
1546 -> Len is Size - From,
1547 RangeEnd is Size - 1
1548 ; Len is To+1 - From, 1549 RangeEnd = To
1550 )
1551 },
1552 content_range(bytes, From, RangeEnd, Size),
1553 content_length(Len, Len).
1554content_length(Reply, Len) -->
1555 { length_of(Reply, Len)
1556 },
1557 "Content-Length: ", integer(Len),
1558 "\r\n".
1559
1560
1561length_of(_, Len) :-
1562 nonvar(Len),
1563 !.
1564length_of(codes(String, Encoding), Len) :-
1565 !,
1566 setup_call_cleanup(
1567 open_null_stream(Out),
1568 ( set_stream(Out, encoding(Encoding)),
1569 format(Out, '~s', [String]),
1570 byte_count(Out, Len)
1571 ),
1572 close(Out)).
1573length_of(atom(Atom, Encoding), Len) :-
1574 !,
1575 setup_call_cleanup(
1576 open_null_stream(Out),
1577 ( set_stream(Out, encoding(Encoding)),
1578 format(Out, '~a', [Atom]),
1579 byte_count(Out, Len)
1580 ),
1581 close(Out)).
1582length_of(file(File), Len) :-
1583 !,
1584 size_file(File, Len).
1585length_of(memory_file(Handle), Len) :-
1586 !,
1587 size_memory_file(Handle, Len, octet).
1588length_of(html_tokens(Tokens), Len) :-
1589 !,
1590 html_print_length(Tokens, Len).
1591length_of(html(Tokens), Len) :- 1592 !,
1593 html_print_length(Tokens, Len).
1594length_of(bytes(Bytes), Len) :-
1595 !,
1596 ( string(Bytes)
1597 -> string_length(Bytes, Len)
1598 ; length(Bytes, Len) 1599 ).
1600length_of(Len, Len).
1601
1602
1607
1608content_range(Unit, From, RangeEnd, Size) -->
1609 "Content-Range: ", atom(Unit), " ",
1610 integer(From), "-", integer(RangeEnd), "/", integer(Size),
1611 "\r\n".
1612
1613content_encoding(Encoding) -->
1614 "Content-Encoding: ", atom(Encoding), "\r\n".
1615
1616transfer_encoding(Encoding) -->
1617 "Transfer-Encoding: ", atom(Encoding), "\r\n".
1618
1619content_type(Type) -->
1620 content_type(Type, _).
1621
1622content_type(Type, Charset) -->
1623 ctype(Type),
1624 charset(Charset),
1625 "\r\n".
1626
1627ctype(Main/Sub) -->
1628 !,
1629 "Content-Type: ",
1630 atom(Main),
1631 "/",
1632 atom(Sub).
1633ctype(Type) -->
1634 !,
1635 "Content-Type: ",
1636 atom(Type).
1637
1638charset(Var) -->
1639 { var(Var) },
1640 !.
1641charset(utf8) -->
1642 !,
1643 "; charset=UTF-8".
1644charset(CharSet) -->
1645 "; charset=",
1646 atom(CharSet).
1647
1653
(Name, Value) -->
1655 { var(Name) }, 1656 !,
1657 field_name(Name),
1658 ":",
1659 whites,
1660 read_field_value(ValueChars),
1661 blanks_to_nl,
1662 !,
1663 { field_to_prolog(Name, ValueChars, Value)
1664 -> true
1665 ; atom_codes(Value, ValueChars),
1666 domain_error(Name, Value)
1667 }.
1668header_field(Name, Value) -->
1669 field_name(Name),
1670 ": ",
1671 field_value(Name, Value),
1672 "\r\n".
1673
1677
1678read_field_value([H|T]) -->
1679 [H],
1680 { \+ code_type(H, space) },
1681 !,
1682 read_field_value(T).
1683read_field_value([]) -->
1684 "".
1685read_field_value([H|T]) -->
1686 [H],
1687 read_field_value(T).
1688
1689
1727
(Field, Value, Prolog) :-
1729 known_field(Field, _, Type),
1730 ( already_parsed(Type, Value)
1731 -> Prolog = Value
1732 ; to_codes(Value, Codes),
1733 parse_header_value(Field, Codes, Prolog)
1734 ).
1735
1736already_parsed(integer, V) :- !, integer(V).
1737already_parsed(list(Type), L) :- !, is_list(L), maplist(already_parsed(Type), L).
1738already_parsed(Term, V) :- subsumes_term(Term, V).
1739
1740
1745
1746known_field(content_length, true, integer).
1747known_field(status, true, integer).
1748known_field(cookie, true, list(_=_)).
1749known_field(set_cookie, true, list(set_cookie(_Name,_Value,_Options))).
1750known_field(host, true, _Host:_Port).
1751known_field(range, maybe, bytes(_,_)).
1752known_field(accept, maybe, list(media(_Type, _Parms, _Q, _Exts))).
1753known_field(content_disposition, maybe, disposition(_Name, _Attributes)).
1754known_field(content_type, false, media(_Type/_Sub, _Attributes)).
1755
1756to_codes(In, Codes) :-
1757 ( is_list(In)
1758 -> Codes = In
1759 ; atom_codes(In, Codes)
1760 ).
1761
1767
1768field_to_prolog(Field, Codes, Prolog) :-
1769 known_field(Field, true, _Type),
1770 !,
1771 ( parse_header_value(Field, Codes, Prolog0)
1772 -> Prolog = Prolog0
1773 ).
1774field_to_prolog(Field, Codes, Prolog) :-
1775 known_field(Field, maybe, _Type),
1776 parse_header_value(Field, Codes, Prolog0),
1777 !,
1778 Prolog = Prolog0.
1779field_to_prolog(_, Codes, Atom) :-
1780 atom_codes(Atom, Codes).
1781
1786
(content_length, ValueChars, ContentLength) :-
1788 number_codes(ContentLength, ValueChars).
1789parse_header_value(status, ValueChars, Code) :-
1790 ( phrase(" ", L, _),
1791 append(Pre, L, ValueChars)
1792 -> number_codes(Code, Pre)
1793 ; number_codes(Code, ValueChars)
1794 ).
1795parse_header_value(cookie, ValueChars, Cookies) :-
1796 debug(cookie, 'Cookie: ~s', [ValueChars]),
1797 phrase(cookies(Cookies), ValueChars).
1798parse_header_value(set_cookie, ValueChars, SetCookie) :-
1799 debug(cookie, 'SetCookie: ~s', [ValueChars]),
1800 phrase(set_cookie(SetCookie), ValueChars).
1801parse_header_value(host, ValueChars, Host) :-
1802 ( append(HostChars, [0':|PortChars], ValueChars),
1803 catch(number_codes(Port, PortChars), _, fail)
1804 -> atom_codes(HostName, HostChars),
1805 Host = HostName:Port
1806 ; atom_codes(Host, ValueChars)
1807 ).
1808parse_header_value(range, ValueChars, Range) :-
1809 phrase(range(Range), ValueChars).
1810parse_header_value(accept, ValueChars, Media) :-
1811 parse_accept(ValueChars, Media).
1812parse_header_value(content_disposition, ValueChars, Disposition) :-
1813 phrase(content_disposition(Disposition), ValueChars).
1814parse_header_value(content_type, ValueChars, Type) :-
1815 phrase(parse_content_type(Type), ValueChars).
1816
1818
1819field_value(_, set_cookie(Name, Value, Options)) -->
1820 !,
1821 atom(Name), "=", atom(Value),
1822 value_options(Options, cookie).
1823field_value(_, disposition(Disposition, Options)) -->
1824 !,
1825 atom(Disposition), value_options(Options, disposition).
1826field_value(www_authenticate, Auth) -->
1827 auth_field_value(Auth).
1828field_value(_, Atomic) -->
1829 atom(Atomic).
1830
1834
1835auth_field_value(negotiate(Data)) -->
1836 "Negotiate ",
1837 { base64(Data, DataBase64),
1838 atom_codes(DataBase64, Codes)
1839 },
1840 string(Codes), "\r\n".
1841auth_field_value(negotiate) -->
1842 "Negotiate\r\n".
1843auth_field_value(basic) -->
1844 !,
1845 "Basic\r\n".
1846auth_field_value(basic(Realm)) -->
1847 "Basic Realm=\"", atom(Realm), "\"\r\n".
1848auth_field_value(digest) -->
1849 !,
1850 "Digest\r\n".
1851auth_field_value(digest(Details)) -->
1852 "Digest ", atom(Details), "\r\n".
1853
1860
1861value_options([], _) --> [].
1862value_options([H|T], Field) -->
1863 "; ", value_option(H, Field),
1864 value_options(T, Field).
1865
1866value_option(secure=true, cookie) -->
1867 !,
1868 "secure".
1869value_option(Name=Value, Type) -->
1870 { string_option(Name, Type) },
1871 !,
1872 atom(Name), "=",
1873 qstring(Value).
1874value_option(Name=Value, Type) -->
1875 { token_option(Name, Type) },
1876 !,
1877 atom(Name), "=", atom(Value).
1878value_option(Name=Value, _Type) -->
1879 atom(Name), "=",
1880 option_value(Value).
1881
1882string_option(filename, disposition).
1883
1884token_option(path, cookie).
1885
1886option_value(Value) -->
1887 { number(Value) },
1888 !,
1889 number(Value).
1890option_value(Value) -->
1891 { ( atom(Value)
1892 -> true
1893 ; string(Value)
1894 ),
1895 forall(string_code(_, Value, C),
1896 token_char(C))
1897 },
1898 !,
1899 atom(Value).
1900option_value(Atomic) -->
1901 qstring(Atomic).
1902
1903qstring(Atomic) -->
1904 { string_codes(Atomic, Codes) },
1905 "\"",
1906 qstring_codes(Codes),
1907 "\"".
1908
1909qstring_codes([]) --> [].
1910qstring_codes([H|T]) --> qstring_code(H), qstring_codes(T).
1911
1912qstring_code(C) --> {qstring_esc(C)}, !, "\\", [C].
1913qstring_code(C) --> [C].
1914
1915qstring_esc(0'").
1916qstring_esc(C) :- ctl(C).
1917
1918
1919 1922
1923:- dynamic accept_cache/2. 1924:- volatile accept_cache/2. 1925
1926parse_accept(Codes, Media) :-
1927 atom_codes(Atom, Codes),
1928 ( accept_cache(Atom, Media0)
1929 -> Media = Media0
1930 ; phrase(accept(Media0), Codes),
1931 keysort(Media0, Media1),
1932 pairs_values(Media1, Media2),
1933 assertz(accept_cache(Atom, Media2)),
1934 Media = Media2
1935 ).
1936
1940
1941accept([H|T]) -->
1942 blanks,
1943 media_range(H),
1944 blanks,
1945 ( ","
1946 -> accept(T)
1947 ; {T=[]}
1948 ).
1949
1950media_range(s(SortQuality,Spec)-media(Type, TypeParams, Quality, AcceptExts)) -->
1951 media_type(Type),
1952 blanks,
1953 ( ";"
1954 -> blanks,
1955 parameters_and_quality(TypeParams, Quality, AcceptExts)
1956 ; { TypeParams = [],
1957 Quality = 1.0,
1958 AcceptExts = []
1959 }
1960 ),
1961 { SortQuality is float(-Quality),
1962 rank_specialised(Type, TypeParams, Spec)
1963 }.
1964
1965
1969
1970content_disposition(disposition(Disposition, Options)) -->
1971 token(Disposition), blanks,
1972 value_parameters(Options).
1973
1978
1979parse_content_type(media(Type, Parameters)) -->
1980 media_type(Type), blanks,
1981 value_parameters(Parameters).
1982
1983
1991
1992rank_specialised(Type/SubType, TypeParams, v(VT, VS, SortVP)) :-
1993 var_or_given(Type, VT),
1994 var_or_given(SubType, VS),
1995 length(TypeParams, VP),
1996 SortVP is -VP.
1997
1998var_or_given(V, Val) :-
1999 ( var(V)
2000 -> Val = 0
2001 ; Val = -1
2002 ).
2003
2004media_type(Type/SubType) -->
2005 type(Type), "/", type(SubType).
2006
2007type(_) -->
2008 "*",
2009 !.
2010type(Type) -->
2011 token(Type).
2012
2013parameters_and_quality(Params, Quality, AcceptExts) -->
2014 token(Name),
2015 blanks, "=", blanks,
2016 ( { Name == q }
2017 -> float(Quality), blanks,
2018 value_parameters(AcceptExts),
2019 { Params = [] }
2020 ; { Params = [Name=Value|T] },
2021 parameter_value(Value),
2022 blanks,
2023 ( ";"
2024 -> blanks,
2025 parameters_and_quality(T, Quality, AcceptExts)
2026 ; { T = [],
2027 Quality = 1.0,
2028 AcceptExts = []
2029 }
2030 )
2031 ).
2032
2037
2038value_parameters([H|T]) -->
2039 ";",
2040 !,
2041 blanks, token(Name), blanks,
2042 ( "="
2043 -> blanks,
2044 ( token(Value)
2045 -> []
2046 ; quoted_string(Value)
2047 ),
2048 { H = (Name=Value) }
2049 ; { H = Name }
2050 ),
2051 blanks,
2052 value_parameters(T).
2053value_parameters([]) -->
2054 [].
2055
2056parameter_value(Value) --> token(Value), !.
2057parameter_value(Value) --> quoted_string(Value).
2058
2059
2063
2064token(Name) -->
2065 token_char(C1),
2066 token_chars(Cs),
2067 { atom_codes(Name, [C1|Cs]) }.
2068
2069token_chars([H|T]) -->
2070 token_char(H),
2071 !,
2072 token_chars(T).
2073token_chars([]) --> [].
2074
2075token_char(C) :-
2076 \+ ctl(C),
2077 \+ separator_code(C).
2078
2079ctl(C) :- between(0,31,C), !.
2080ctl(127).
2081
2082separator_code(0'().
2083separator_code(0')).
2084separator_code(0'<).
2085separator_code(0'>).
2086separator_code(0'@).
2087separator_code(0',).
2088separator_code(0';).
2089separator_code(0':).
2090separator_code(0'\\).
2091separator_code(0'").
2092separator_code(0'/).
2093separator_code(0'[).
2094separator_code(0']).
2095separator_code(0'?).
2096separator_code(0'=).
2097separator_code(0'{).
2098separator_code(0'}).
2099separator_code(0'\s).
2100separator_code(0'\t).
2101
2102term_expansion(token_char(x) --> [x], Clauses) :-
2103 findall((token_char(C)-->[C]),
2104 ( between(0, 255, C),
2105 token_char(C)
2106 ),
2107 Clauses).
2108
2109token_char(x) --> [x].
2110
2114
2115quoted_string(Text) -->
2116 "\"",
2117 quoted_text(Codes),
2118 { atom_codes(Text, Codes) }.
2119
2120quoted_text([]) -->
2121 "\"",
2122 !.
2123quoted_text([H|T]) -->
2124 "\\", !, [H],
2125 quoted_text(T).
2126quoted_text([H|T]) -->
2127 [H],
2128 !,
2129 quoted_text(T).
2130
2131
2139
([], _) --> [].
2141header_fields([content_length(CLen)|T], CLen) -->
2142 !,
2143 ( { var(CLen) }
2144 -> ""
2145 ; header_field(content_length, CLen)
2146 ),
2147 header_fields(T, CLen). 2148header_fields([status(_)|T], CLen) --> 2149 !,
2150 header_fields(T, CLen).
2151header_fields([H|T], CLen) -->
2152 { H =.. [Name, Value] },
2153 header_field(Name, Value),
2154 header_fields(T, CLen).
2155
2156
2170
2171:- public
2172 field_name//1. 2173
2174field_name(Name) -->
2175 { var(Name) },
2176 !,
2177 rd_field_chars(Chars),
2178 { atom_codes(Name, Chars) }.
2179field_name(mime_version) -->
2180 !,
2181 "MIME-Version".
2182field_name(www_authenticate) -->
2183 !,
2184 "WWW-Authenticate".
2185field_name(Name) -->
2186 { atom_codes(Name, Chars) },
2187 wr_field_chars(Chars).
2188
2189rd_field_chars_no_fold([C|T]) -->
2190 [C],
2191 { rd_field_char(C, _) },
2192 !,
2193 rd_field_chars_no_fold(T).
2194rd_field_chars_no_fold([]) -->
2195 [].
2196
2197rd_field_chars([C0|T]) -->
2198 [C],
2199 { rd_field_char(C, C0) },
2200 !,
2201 rd_field_chars(T).
2202rd_field_chars([]) -->
2203 [].
2204
2208
2209separators("()<>@,;:\\\"/[]?={} \t").
2210
2211term_expansion(rd_field_char('expand me',_), Clauses) :-
2212
2213 Clauses = [ rd_field_char(0'-, 0'_)
2214 | Cls
2215 ],
2216 separators(SepString),
2217 string_codes(SepString, Seps),
2218 findall(rd_field_char(In, Out),
2219 ( between(32, 127, In),
2220 \+ memberchk(In, Seps),
2221 In \== 0'-, 2222 code_type(Out, to_lower(In))),
2223 Cls).
2224
2225rd_field_char('expand me', _). 2226
2227wr_field_chars([C|T]) -->
2228 !,
2229 { code_type(C, to_lower(U)) },
2230 [U],
2231 wr_field_chars2(T).
2232wr_field_chars([]) -->
2233 [].
2234
2235wr_field_chars2([]) --> [].
2236wr_field_chars2([C|T]) --> 2237 ( { C == 0'_ }
2238 -> "-",
2239 wr_field_chars(T)
2240 ; [C],
2241 wr_field_chars2(T)
2242 ).
2243
2247
2248now -->
2249 { get_time(Time)
2250 },
2251 rfc_date(Time).
2252
2257
2258rfc_date(Time, String, Tail) :-
2259 stamp_date_time(Time, Date, 'UTC'),
2260 format_time(codes(String, Tail),
2261 '%a, %d %b %Y %T GMT',
2262 Date, posix).
2263
2267
2268http_timestamp(Time, Atom) :-
2269 stamp_date_time(Time, Date, 'UTC'),
2270 format_time(atom(Atom),
2271 '%a, %d %b %Y %T GMT',
2272 Date, posix).
2273
2274
2275 2278
2279request(Fd, [method(Method),request_uri(ReqURI)|Header]) -->
2280 method(Method),
2281 blanks,
2282 nonblanks(Query),
2283 { atom_codes(ReqURI, Query),
2284 request_uri_parts(ReqURI, Header, Rest)
2285 },
2286 request_header(Fd, Rest),
2287 !.
2288request(Fd, [unknown(What)|Header]) -->
2289 string(What),
2290 eos,
2291 !,
2292 { http_read_header(Fd, Header)
2293 -> true
2294 ; Header = []
2295 }.
2296
2297method(get) --> "GET", !.
2298method(put) --> "PUT", !.
2299method(head) --> "HEAD", !.
2300method(post) --> "POST", !.
2301method(delete) --> "DELETE", !.
2302method(patch) --> "PATCH", !.
2303method(options) --> "OPTIONS", !.
2304method(trace) --> "TRACE", !.
2305
2317
2318request_uri_parts(ReqURI, [path(Path)|Parts], Rest) :-
2319 uri_components(ReqURI, Components),
2320 uri_data(path, Components, PathText),
2321 uri_encoded(path, Path, PathText),
2322 phrase(uri_parts(Components), Parts, Rest).
2323
2324uri_parts(Components) -->
2325 uri_search(Components),
2326 uri_fragment(Components).
2327
2328uri_search(Components) -->
2329 { uri_data(search, Components, Search),
2330 nonvar(Search),
2331 catch(uri_query_components(Search, Query),
2332 error(syntax_error(_),_),
2333 fail)
2334 },
2335 !,
2336 [ search(Query) ].
2337uri_search(_) --> [].
2338
2339uri_fragment(Components) -->
2340 { uri_data(fragment, Components, String),
2341 nonvar(String),
2342 !,
2343 uri_encoded(fragment, Fragment, String)
2344 },
2345 [ fragment(Fragment) ].
2346uri_fragment(_) --> [].
2347
2352
(_, []) --> 2354 blanks,
2355 eos,
2356 !.
2357request_header(Fd, [http_version(Version)|Header]) -->
2358 http_version(Version),
2359 blanks,
2360 eos,
2361 !,
2362 { Version = 1-_
2363 -> http_read_header(Fd, Header)
2364 ; Header = []
2365 }.
2366
2367http_version(Version) -->
2368 blanks,
2369 "HTTP/",
2370 http_version_number(Version).
2371
2372http_version_number(Major-Minor) -->
2373 integer(Major),
2374 ".",
2375 integer(Minor).
2376
2377
2378 2381
2385
2386cookies([Name=Value|T]) -->
2387 blanks,
2388 cookie(Name, Value),
2389 !,
2390 blanks,
2391 ( ";"
2392 -> cookies(T)
2393 ; { T = [] }
2394 ).
2395cookies(List) -->
2396 string(Skipped),
2397 ";",
2398 !,
2399 { print_message(warning, http(skipped_cookie(Skipped))) },
2400 cookies(List).
2401cookies([]) -->
2402 blanks.
2403
2404cookie(Name, Value) -->
2405 cookie_name(Name),
2406 blanks, "=", blanks,
2407 cookie_value(Value).
2408
2409cookie_name(Name) -->
2410 { var(Name) },
2411 !,
2412 rd_field_chars_no_fold(Chars),
2413 { atom_codes(Name, Chars) }.
2414
2415cookie_value(Value) -->
2416 quoted_string(Value),
2417 !.
2418cookie_value(Value) -->
2419 chars_to_semicolon_or_blank(Chars),
2420 { atom_codes(Value, Chars)
2421 }.
2422
2423chars_to_semicolon_or_blank([H|T]) -->
2424 [H],
2425 { H \== 32, H \== 0'; },
2426 !,
2427 chars_to_semicolon_or_blank(T).
2428chars_to_semicolon_or_blank([]) -->
2429 [].
2430
2431set_cookie(set_cookie(Name, Value, Options)) -->
2432 ws,
2433 cookie(Name, Value),
2434 cookie_options(Options).
2435
2436cookie_options([H|T]) -->
2437 ws,
2438 ";",
2439 ws,
2440 cookie_option(H),
2441 !,
2442 cookie_options(T).
2443cookie_options([]) -->
2444 ws.
2445
2446ws --> " ", !, ws.
2447ws --> [].
2448
2449
2459
2460cookie_option(Name=Value) -->
2461 rd_field_chars(NameChars), ws,
2462 { atom_codes(Name, NameChars) },
2463 ( "="
2464 -> ws,
2465 chars_to_semicolon(ValueChars),
2466 { atom_codes(Value, ValueChars)
2467 }
2468 ; { Value = true }
2469 ).
2470
2471chars_to_semicolon([H|T]) -->
2472 [H],
2473 { H \== 32, H \== 0'; },
2474 !,
2475 chars_to_semicolon(T).
2476chars_to_semicolon([]), ";" -->
2477 ws, ";",
2478 !.
2479chars_to_semicolon([H|T]) -->
2480 [H],
2481 chars_to_semicolon(T).
2482chars_to_semicolon([]) -->
2483 [].
2484
2492
2493range(bytes(From, To)) -->
2494 "bytes", whites, "=", whites, integer(From), "-",
2495 ( integer(To)
2496 -> ""
2497 ; { To = end }
2498 ).
2499
2500
2501 2504
2519
2520reply(Fd, [http_version(HttpVersion), status(Code, Status, Comment)|Header]) -->
2521 http_version(HttpVersion),
2522 blanks,
2523 ( status_number(Status, Code)
2524 -> []
2525 ; integer(Status)
2526 ),
2527 blanks,
2528 string(CommentCodes),
2529 blanks_to_nl,
2530 !,
2531 blanks,
2532 { atom_codes(Comment, CommentCodes),
2533 http_read_header(Fd, Header)
2534 }.
2535
2536
2537 2540
2546
(Fd, Header) :-
2548 read_header_data(Fd, Text),
2549 http_parse_header(Text, Header).
2550
(Fd, Header) :-
2552 read_line_to_codes(Fd, Header, Tail),
2553 read_header_data(Header, Fd, Tail),
2554 debug(http(header), 'Header = ~n~s~n', [Header]).
2555
([0'\r,0'\n], _, _) :- !.
2557read_header_data([0'\n], _, _) :- !.
2558read_header_data([], _, _) :- !.
2559read_header_data(_, Fd, Tail) :-
2560 read_line_to_codes(Fd, Tail, NewTail),
2561 read_header_data(Tail, Fd, NewTail).
2562
2569
(Text, Header) :-
2571 phrase(header(Header), Text),
2572 debug(http(header), 'Field: ~p', [Header]).
2573
(List) -->
2575 header_field(Name, Value),
2576 !,
2577 { mkfield(Name, Value, List, Tail)
2578 },
2579 blanks,
2580 header(Tail).
2581header([]) -->
2582 blanks,
2583 eos,
2584 !.
2585header(_) -->
2586 string(S), blanks_to_nl,
2587 !,
2588 { string_codes(Line, S),
2589 syntax_error(http_parameter(Line))
2590 }.
2591
2603
2604:- multifile
2605 http:http_address//0. 2606
2607address -->
2608 http:http_address,
2609 !.
2610address -->
2611 { gethostname(Host) },
2612 html(address([ a(href('http://www.swi-prolog.org'), 'SWI-Prolog'),
2613 ' httpd at ', Host
2614 ])).
2615
2616mkfield(host, Host:Port, [host(Host),port(Port)|Tail], Tail) :- !.
2617mkfield(Name, Value, [Att|Tail], Tail) :-
2618 Att =.. [Name, Value].
2619
2625
2655
2656
2657 2660
2661:- multifile
2662 prolog:message//1,
2663 prolog:error_message//1. 2664
2665prolog:error_message(http_write_short(Data, Sent)) -->
2666 data(Data),
2667 [ ': remote hangup after ~D bytes'-[Sent] ].
2668prolog:error_message(syntax_error(http_request(Request))) -->
2669 [ 'Illegal HTTP request: ~s'-[Request] ].
2670prolog:error_message(syntax_error(http_parameter(Line))) -->
2671 [ 'Illegal HTTP parameter: ~s'-[Line] ].
2672
2673prolog:message(http(skipped_cookie(S))) -->
2674 [ 'Skipped illegal cookie: ~s'-[S] ].
2675
2676data(bytes(MimeType, _Bytes)) -->
2677 !,
2678 [ 'bytes(~p, ...)'-[MimeType] ].
2679data(Data) -->
2680 [ '~p'-[Data] ]