module Format = Stdlib.Format module Arg = Stdlib.Arg open Lwt.Infix open Httpaf module Server = struct include Httpaf_lwt_unix.Server let error_handler ?request:_ error start_response = let response_body = start_response Headers.empty in (match error with | `Exn exn -> Body.write_string response_body (Base.Exn.to_string exn); Body.write_string response_body "\n" | #Status.standard as error -> Body.write_string response_body (Status.default_reason_phrase error)); Body.close_writer response_body end let proxy_host = "gitea.departmentofinter.net" let file_response_headers = [ ("accept-ranges", "bytes"); ("access-control-allow-origin", "*"); ( "access-control-allow-headers", "Origin, X-Requested-With, Content-Type, Accept, Range" ); ("cache-control", "no-cache, no-store, must-revalidate"); ("etag", "W/\"6861266-5562-2024-02-11T19:05:04.733Z\""); ("content-type", "text/html; charset=UTF-8"); ("connection", "close"); ] let proxy_handler reqd : unit = match Reqd.request reqd with | Request.{ meth; headers; target; _ } -> Lwt.async (fun () -> let filename = Fmt.str "./%s" target in if Sys.file_exists filename (* && Sys.is_regular_file filename *) then ( let file = Lwt_io.open_file ~flags:[ O_RDONLY ] ~mode:Lwt_io.input filename in let headers = Headers.of_list file_response_headers in Lwt_io.file_length filename >>= fun file_len -> let headers = Headers.add_list headers [ ("content-length", Int64.to_string file_len) ] in Format.printf ">>> Response with File:\nHeaders:\n%s\n %!" (Headers.to_string headers); let response = Response.create ~headers `OK in let response_body = Reqd.respond_with_streaming reqd response in file >>= fun file -> let rec reader () = if Int64.compare (Int64.sub file_len (Lwt_io.position file)) Int64.zero > 0 then ( Lwt_io.read file >>= fun s -> Format.printf ".%i\n%!" (String.length s); Body.write_string response_body s; reader ()) else Lwt.return_unit >>= fun () -> Lwt.return_unit in reader () >>= fun () -> Body.close_writer response_body; Lwt_io.close file >>= fun () -> Format.printf "done%!"; Lwt.return_unit) else let uri = Fmt.str "https://%s%s" proxy_host target in let proxy_finished, proxy_notify_finished = Lwt.wait () in let proxy_response_handler _ (proxy_response_body_acc : Buffer.t) proxy_response_body = Format.printf ">>> proxy_response_body chunk: %i\n%!" (String.length proxy_response_body); Buffer.add_string proxy_response_body_acc proxy_response_body; Lwt.return proxy_response_body_acc in let request_headers = Headers.replace headers "Host" proxy_host in let request_headers = Headers.replace request_headers "origin" (Fmt.str "https://%s" proxy_host) in let request_headers = Headers.replace request_headers "content-type" "application/x-git-upload-pack-request" in let proxy_request_headers = Headers.of_list [ ("Accept-Language", "en-US, *;q=0.9"); ("Accept", "application/x-git-upload-pack-result"); ( "Content-Type", "application/x-git-receive-upload-request" ); ("Accept-Encoding", "deflate, gzip, br, zstd"); ("User-Agent", "git/2.43.0"); ( "Authorization", "Basic \ Y3FjOmQ5YzJiNDkxZTcwZTMxYTc2MGNlNzBiYzQzMTAzNmM5MTMyNWY2ODM=" ); ("Host", "gitea.departmentofinter.net"); ( "Content-Length", Option.fold ~some:Fun.id ~none:"0" (Headers.get headers "content-length") ); ] in let request_body = Reqd.request_body reqd in let request_body_buffer = Bigstringaf.create (Option.fold ~some:int_of_string ~none:4096 (Headers.get headers "content-length")) in let response_body_buffer = Buffer.create 0 in let rec on_read buffer ~off ~len = Bigstringaf.blit buffer ~src_off:off request_body_buffer ~dst_off:off ~len; Body.schedule_read request_body ~on_eof ~on_read and on_eof () = Body.close_reader request_body in Body.schedule_read request_body ~on_eof ~on_read; Format.printf ">>> Proxy Request: Target:%s Headers:\n%s\n%!" target (String.trim (Headers.to_string request_headers)); Format.printf ">>> Proxy Request Body length: %i\n%!" (Bigstringaf.length request_body_buffer); Http_lwt_client.request ?config:(Some (`HTTP_1_1 Httpaf.Config.default)) ~meth ~headers:(Headers.to_list request_headers) ?body:(Some (Bigstringaf.to_string request_body_buffer)) ~follow_redirect:false uri proxy_response_handler response_body_buffer >>= function | Ok ( { version; status; reason; headers }, proxy_response_body_acc ) -> Format.printf ">>> Response Ok: Code: %i Reason: %s Headers:\n\ %s\n\ %!" (H2.Status.to_code status) reason (String.trim (H2.Headers.to_string headers)); let headers = Headers.of_list (H2.Headers.to_list headers) in let status = Status.of_code (H2.Status.to_code status) in let response = let content_type = match Headers.get headers "content-type" with | None -> "application/octet-stream" | Some x -> x in Response.create ~reason ~version ~headers: (Headers.replace headers "content-type" content_type) status in let response_body = Reqd.respond_with_streaming reqd response in Body.write_string response_body ~off:0 ~len:(Buffer.length proxy_response_body_acc) (Buffer.contents proxy_response_body_acc); Body.close_writer response_body; Lwt.wakeup_later proxy_notify_finished (); Lwt.return_unit | Error (`Msg msg) -> Format.printf "Request failed with %s%!" msg; Lwt.return_unit >>= fun () -> proxy_finished) (* | _ -> let headers = Headers.of_list [ ("connection", "close") ] in Reqd.respond_with_string reqd (Response.create ~headers `Method_not_allowed) "" *) let request_handler (_ : Unix.sockaddr) = proxy_handler let error_handler (_ : Unix.sockaddr) = Server.error_handler let main port = let listen_address = Unix.(ADDR_INET (inet_addr_loopback, port)) in Lwt.async (fun () -> Lwt_io.establish_server_with_client_socket listen_address (Server.create_connection_handler ~request_handler ~error_handler) >|= fun _server -> Stdio.printf "Listening on localhost:%i and proxying requests via \ https://%s.\n\ %!" port proxy_host); let forever, _ = Lwt.wait () in Lwt_main.run forever let () = let port = ref 8080 in main !port