shell.ml 3.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118
  1. (*
  2. * _ _ ____ _
  3. * _| || |_/ ___| ___ _ __ _ __ ___ | |
  4. * |_ .. _\___ \ / _ \ '_ \| '_ \ / _ \| |
  5. * |_ _|___) | __/ |_) | |_) | (_) |_|
  6. * |_||_| |____/ \___| .__/| .__/ \___/(_)
  7. * |_| |_|
  8. *
  9. * Personal Social Web.
  10. *
  11. * Copyright (C) The #Seppo contributors. All rights reserved.
  12. *
  13. * This program is free software: you can redistribute it and/or modify
  14. * it under the terms of the GNU General Public License as published by
  15. * the Free Software Foundation, either version 3 of the License, or
  16. * (at your option) any later version.
  17. *
  18. * This program is distributed in the hope that it will be useful,
  19. * but WITHOUT ANY WARRANTY; without even the implied warranty of
  20. * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  21. * GNU General Public License for more details.
  22. *
  23. * You should have received a copy of the GNU General Public License
  24. * along with this program. If not, see <http://www.gnu.org/licenses/>.
  25. *)
  26. (* https://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html *)
  27. let ( >>= ) = Result.bind
  28. let ( let* ) = Result.bind
  29. let err i msgs =
  30. let exe = Filename.basename Sys.executable_name in
  31. msgs |> List.cons exe |> String.concat ": " |> prerr_endline;
  32. i
  33. open Seppo_lib
  34. let webfinger acct =
  35. let* w = acct |> Webfinger.well_known_uri in
  36. (try w |> Webfinger.Client.http_get
  37. with
  38. Ezjsonm.Parse_error (_, e) ->
  39. Logr.err (fun m -> m "%s failed to decipher %a" E.e9001 Uri.pp w);
  40. Lwt.return (Error e))
  41. |> Lwt_main.run
  42. (* TODO add more compliance rules. Check pk. *)
  43. let actor ?(key : Http.t_sign_k option = None) u =
  44. u
  45. |> Ap.Actor.http_get ~key
  46. |> Lwt_main.run
  47. (*
  48. >>= As2.Profile.pubkey_pem
  49. >>= As2.PubKeyPem.pub_from_pem
  50. >>= As2.PubKeyPem.check
  51. *)
  52. let exec (args : string list) =
  53. let print_version oc =
  54. let exe = Filename.basename Sys.executable_name in
  55. Printf.fprintf oc "%s: https://Seppo.Social/v/%s+%s\n" exe Version.dune_project_version Version.git_sha;
  56. 0
  57. and print_help oc =
  58. let _exe = Filename.basename Sys.executable_name in
  59. Printf.fprintf oc
  60. "\n\
  61. Query AP servers.\n\n\
  62. If run from commandline:\n\n\
  63. OPTIONS\n\n\
  64. \ --help, -h\n\
  65. \ print this help\n\n\
  66. \ --version, -V\n\
  67. \ print version\n\n\
  68. COMMANDS\n\n\
  69. \ webfinger alice@example.com\n\
  70. \ the webfinger json parsed and re-written.\n\n\
  71. \ actor https://example.com/actors/alice\n\
  72. \ the AP profile page parsed and re-written.\n\n\
  73. \ doap\n\
  74. \ show 'description of a project'\n\n";
  75. 0
  76. and oc = stdout in
  77. let tail s = function
  78. | Error e ->
  79. Logr.err (fun m -> m "%s '%s': %s" E.e1006 s e);
  80. 1
  81. | Ok _ ->
  82. Logr.info (fun m -> m "%s." s);
  83. 0
  84. in
  85. match args with
  86. | [ _; "-h" ] | [ _; "--help" ] -> print_help oc
  87. | [ _; "-V" ] | [ _; "--version" ] -> print_version oc
  88. | [ _; "doap" ] ->
  89. (match "doap.rdf" |> Res.read with
  90. | Some v -> Printf.fprintf oc "%s" v
  91. | None -> ());
  92. 0
  93. | [ _; "webfinger"; acct ] ->
  94. (let* q = acct
  95. |> Webfinger.of_string
  96. |> webfinger in
  97. q
  98. |> As2_vocab.Encode.Webfinger.query_result ~base:Uri.empty
  99. |> Ezjsonm.value_to_channel stdout;
  100. Ok q)
  101. |> tail "webfinger"
  102. | [ _; "actor"; url] ->
  103. (let* p = url |> Uri.of_string |> actor in
  104. let context = As2_vocab.Constants.ActivityStreams.und in
  105. p
  106. |> As2_vocab.Encode.person ~context ~base:Uri.empty
  107. |> Ezjsonm.value_to_channel stdout;
  108. Ok p)
  109. |> tail "actor"
  110. | _ -> err 2 [ "get help with -h" ]