From 8f52e91dab637e4d37fa160944997b1e9f1f9361 Mon Sep 17 00:00:00 2001 From: Marcus Rohrmoser Date: Mon, 14 Oct 2024 16:29:49 +0200 Subject: [PATCH] http stuff. --- doc/wb/themes/current/linkform.xsl | 1 + lib/cgi.ml | 31 ++++++++++++ lib/http.ml | 1 + lib/is2s.ml | 23 ++------- res/static/apchk.xml | 65 ++++++++++++++------------ res/static/themes/current/linkform.xsl | 3 +- test/t_http.ml | 64 +++++++++++++++++++++++++ test/t_storage.ml | 4 +- 8 files changed, 141 insertions(+), 51 deletions(-) diff --git a/doc/wb/themes/current/linkform.xsl b/doc/wb/themes/current/linkform.xsl index 40e6508..514f977 100644 --- a/doc/wb/themes/current/linkform.xsl +++ b/doc/wb/themes/current/linkform.xsl @@ -73,6 +73,7 @@

Copy Emoji to Clipboard: + diff --git a/lib/cgi.ml b/lib/cgi.ml index dc1571e..69741d4 100644 --- a/lib/cgi.ml +++ b/lib/cgi.ml @@ -73,6 +73,22 @@ module Request = struct server_port : string; raw_string : string -> string option } + + let empty = { + content_type = "text/plain"; + content_length = None; + host = "127.0.0.1"; + http_cookie = ""; + path_info = "/"; + query_string = ""; + remote_addr = "127.0.0.1"; + request_method = "GET"; + scheme = "http"; + script_name = ""; + server_port = "80"; + raw_string = (fun _ -> None); + } + (** Request meta data. https://tools.ietf.org/html/rfc3875#section-4.1.13 *) (* https://tools.ietf.org/html/rfc3875 *) @@ -206,6 +222,21 @@ module Request = struct match r.query_string with | "" -> u | q -> q |> Uri.query_of_encoded |> Uri.with_query u + + (** fetch http header values and map from lowercase plus the special name (request-target) *) + let header_get (r : t) = function + | "(request-target)" -> Printf.sprintf "%s %s" + (r.request_method |> String.Ascii.lowercase) + (r |> path_and_query |> Uri.to_string) + |> Option.some + | k -> + let toenv = String.map (function + | '-' -> '_' + | c -> Char.Ascii.uppercase c) in + match toenv k with + | "CONTENT_LENGTH" + | "CONTENT_TYPE" as k -> k |> r.raw_string + | k -> ("HTTP_" ^ k) |> r.raw_string end module Response = struct diff --git a/lib/http.ml b/lib/http.ml index 4deff0d..98368c1 100644 --- a/lib/http.ml +++ b/lib/http.ml @@ -286,6 +286,7 @@ module Signature = struct *) Tyre.eval P.list_auth_param + (** add (request-target) iff request given *) let to_sign_string0 ~request h : string = let h = h |> Cohttp.Header.to_frames in (match request with diff --git a/lib/is2s.ml b/lib/is2s.ml index 46d027a..4a8be9b 100644 --- a/lib/is2s.ml +++ b/lib/is2s.ml @@ -26,21 +26,9 @@ * along with this program. If not, see . *) -(* https://www.w3.org/TR/activitypub/#inbox *) +(** https://www.w3.org/TR/activitypub/#inbox *) module Inbox = struct - (* fetch http header values and map from lowercase plus the special name (request-target) *) - let hdr (r : Cgi.Request.t) h = - let toenv = String.map (function - | '-' -> '_' - | c -> Char.uppercase_ascii c) in - let v = match toenv h with - | "(REQUEST_TARGET)" -> (String.lowercase_ascii r.request_method) ^ " " ^ (r |> Cgi.Request.path_and_query |> Uri.to_string) - | "CONTENT_LENGTH" - | "CONTENT_TYPE" as h -> h |> r.raw_string |> Option.value ~default:"" - | h -> ("HTTP_" ^ h) |> r.raw_string |> Option.value ~default:"" in - Some v - - (* take a list of header names and fetch them incl. values. *) + (** take a list of header names and fetch them incl. values. *) let hdrs hdr = List.fold_left (fun init k -> @@ -50,7 +38,7 @@ module Inbox = struct ) (Cohttp.Header.init ()) - (* Receive the post request, verify the signature, parse the json and dispatch *) + (** Receive the post request, verify the signature, parse the json and dispatch *) let post ?(blocked = Mapcdb.Cdb "app/var/db/subscribed_to.cdb") ~base @@ -62,7 +50,7 @@ module Inbox = struct let run_delay_s = 60 in let agent = Cgi.Request.hHTTP_USER_AGENT |> r.raw_string in Logr.debug (fun m -> m "%s.%s Host:%s User_Agent:'%s'" "Is2s.Inbox" "post" r.remote_addr (agent |> Option.value ~default:"-")); - let*% si_v = "signature" |> hdr r |> Option.to_result ~none:Http.s422' in + let*% si_v = "signature" |> Cgi.Request.header_get r |> Option.to_result ~none:Http.s422' in Logr.debug (fun m -> m "%s.%s %a Signature: %s" "Is2s.Inbox" "post" Uuidm.pp uuid si_v); (* Logr.debug (fun m -> m "%s.%s the signature header:\n%s" "Is2s.Inbox" "post" si_v); *) let*% si_v = si_v @@ -109,7 +97,7 @@ module Inbox = struct Result.map_error mapr in let*% key = Ap.PubKeyPem.of_pem siac.public_key.pem |> map_er0 "parse key" in (* TODO? compare the key to what we knew before from this actor *) - let heads = heads |> hdrs (hdr r) in + let heads = heads |> hdrs (Cgi.Request.header_get r) in let tx = heads |> Http.Signature.to_sign_string0 ~request:None in Logr.debug (fun m -> m "%s.%s signature check '%s'" "Is2s.Inbox" "post" tx); let*% _ = tx @@ -186,4 +174,3 @@ module Inbox = struct let%lwt _ = Main.Queue.ping_and_forget ~base ~run_delay_s in r end - diff --git a/res/static/apchk.xml b/res/static/apchk.xml index 942efa2..c84d873 100644 --- a/res/static/apchk.xml +++ b/res/static/apchk.xml @@ -2,6 +2,7 @@ + @@ -9,52 +10,56 @@ Resolve WebFinger RFC7033 etc. -

WebFinger RFC7033

-

Resolve names like @alice@example.com (WebFinger URIs), - http GET the JSON Resource - Descriptor, parse as understood by #Seppo, re-encode and - return as json. Usually a subset of the input.

+

WebFinger RFC7033

+
    +
  1. Resolve names like @alice@example.com, alice@example.com or acct:alice@example.com + (WebFinger URIs),
    2. +
  2. http GET the JSON Resource + Descriptor,
    3. +
  3. parse as understood by #Seppo,
    4. +
  4. re-encode and return as json. Usually a subset of the input.
    5. +
Redirect automatically to

-