seppo/bin/shell.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * shell.ml
 *
 * Copyright (C) The #Seppo contributors. All rights reserved.
 *
 * This program is free software: you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation, either version 3 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program.  If not, see <http://www.gnu.org/licenses/>.
 *)

open Seppo_lib
open Astring

(* https://caml.inria.fr/pub/docs/manual-ocaml/libref/Sys.html *)

let ( >>= ) = Result.bind
let ( let* ) = Result.bind

let err i msgs =
  let exe = Filename.basename Sys.executable_name in
  msgs |> List.cons exe |> String.concat ~sep:": " |> prerr_endline;
  i

let exec (args : string list) =
  let print_version oc =
    let exe = Filename.basename Sys.executable_name in
    Printf.fprintf oc "%s: https://Seppo.Social/v/%s+%s\n" exe Version.dune_project_version Version.git_sha;
    0
  and print_help oc =
    let _exe = Filename.basename Sys.executable_name in
    Printf.fprintf oc
      {|Some basic tasks on Seppo.Social installations.

If run from commandline:

OPTIONS

  --help, -h
      print this help

  --version, -V
      print version

COMMANDS

  abs2id
      make absolute urls relative to base
  ids
      dump ids
  id2page
      look up page indexes for ids
  page2s
      look up posts for page indexes
  s2atom
      turn posts to an atom feed
  make <files>
      refresh if necessary
  doap
      show 'description of a project'
  dot
      print file dependencies

  note < msg
      post a message
|};
(*
      "\n\
      \  info\n\
      \      tell more about this instance\n\n\
      \  key-rotate\n\
      \      generate new keys\n\n\
      \  make\n\
      \      'make' file dependencies\n\n\
      \  tag sift\n\
      \      filter stdin to stdout\n\n\
      \  activitypub\n\
      \      make activitypub/index.json\n\n"; *)
    0
  and oc = stdout in
  let tail s = function
    | Error e ->
      Logr.err (fun m -> m "%s '%s': %s" E.e1004 s e);
      1
    | Ok _ ->
      Logr.info (fun m -> m "%s." s);
      0
  in
  let rz = Ap.Followers.Atom.rule
           :: Ap.Followers.Json.rule
           :: Ap.Following.Subscribed_to.Atom.rule
           :: Ap.Following.Subscribed_to.Json.rule
           :: Ap.Person.rule
           :: Ap.PersonX.rule
           :: Ap.PubKeyPem.pk_rule
           :: Ap.PubKeyPem.rule
           :: Main.Note.Atom.rule
           :: Webfinger.rule
           :: Webfinger.Server.rule
           :: [] in
  match args with
  | [ _; "-h" ] | [ _; "--help" ] -> print_help oc
  | [ _; "-V" ] | [ _; "--version" ] -> print_version oc
  | [ a0; "abs2id" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    (match Cfg.Base.(from_file fn) with
     | Error _e ->
       Logr.err (fun m -> m "can't happen");
       1
     | Ok base ->
       File.fold_lines (fun init li ->
           let u = li
                   |> Uri.of_string
                   |> Http.abs_to_rel ~base in
           Format.printf "%a\n" Uri.pp u;
           init) 0 stdin )
  | [ a0; "ids" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    Mapcdb.fold_left (fun init (id,_) ->
        print_bytes id;
        print_newline ();
        init) 0 Storage.fn_id_cdb
  | [ a0; "id2page" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    File.fold_lines (fun init li ->
        match li
              |> Uri.of_string
              |> Storage.TwoPad10.from_id with
        | Error e ->
          prerr_string e;
          init
        | Ok ix ->
          ix
          |> Storage.TwoPad10.to_string
          |> print_string;
          init) 0 stdin
  | [ a0; "page2s" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    (match stdin |> Csexp.input_many with
     | Error e -> prerr_string e;
       1
     | Ok sx ->
       let l = sx
               |> List.rev
               |> Storage.TwoPad10.decode_many in
       Storage.fn |> File.in_channel
         (fun ic ->
            List.fold_left (fun init (p0,p1) ->
                seek_in ic p0;
                really_input_string ic (p1-p0)
                |> print_string;
                init)
              0
              l ) )
  | [ a0; "s2atom" ] ->
    a0 |> Filename.dirname |> Unix.chdir;
    (match Cfg.Base.(from_file fn) with
     | Error e ->
       Logr.err (fun m -> m "can't happen: %s" e);
       1
     | Ok base ->
       match stdin |> Csexp.input_many with
       | Error e -> prerr_string e;
         1
       | Ok sx ->
         let fxo x = Xmlm.output_doc_tree
             (fun x -> x)
             (Xmlm.make_output ~decl:false (`Channel stdout))
             (None,x) in
         `El (((Xml.ns_a,"feed"),[
             ((Xmlm.ns_xmlns,"xmlns"),Xml.ns_a);
             ((Xmlm.ns_xmlns,"wf"),Xml.ns_rfc7033);
             (* ((Xmlm.ns_xml,"lang"),lang); *)
             ((Xmlm.ns_xml,"base"),base |> Uri.to_string);
           ]),
              List.fold_left (fun init sx ->
                  match sx |> Rfc4287.Entry.decode with
                  | Error e -> Printf.eprintf "error: %s\n" e;
                    init
                  | Ok e ->
                    (e |> Rfc4287.Entry.to_atom ~base)
                    :: init )
                [] sx )
         |> fxo;
         0 )
  | _ :: ("make" as cmd) :: files ->
    Logr.info (fun m -> m "%s %s" cmd (String.concat ~sep:" " files));
    files
    |> List.fold_left
      (fun a fn -> Result.bind a (fun _ -> Make.M2.make rz fn) )
      (Ok "")
    |> tail cmd
  | [ _; "doap" ] ->
    (match "doap.rdf" |> Res.read with
     | Some v -> Printf.fprintf oc "%s" v
     | None -> ());
    0
  | [ _b; "note" ] ->
    (let* base,profile,author = Main.Note.load_basics () in
     let* pk                  = Ap.PubKeyPem.(private_of_pem pk_pem) in
     let* _ =
       stdin
       |> Rfc4287.Entry.from_channel ~author ~lang:profile.language ~tz:profile.timezone
       >>= Main.sift_urls
       >>= Main.sift_tags Tag.cdb
       >>= Main.sift_handles
       >>= Main.Note.publish ~base ~profile ~author
       >>= Main.Note.Create.notify_subscribers ~base in
     Lwt_main.run (Main.Queue.process_new_and_due ~base ~pk Job.qn)
    ) |> tail "note"
  | [ _; "info" ] ->
    0
(*
      | [ _; "append" ] -> (
      let now = (Ptime_clock.now (), Ptime_clock.current_tz_offset_s ()) in
      match Txt.of_channel now [] stdin with
      | Ok e -> (
          match Sepp0.append e with Ok _ -> 0 | Error s -> err 4 [ s ])
      | Error _ -> err 5 [ "ouch 300" ])
*)
  | [ _; "dot" ] ->
    ( match Make.dot oc rz with
      | Error _ -> 1
      | Ok _ -> 0)
  | [ _; "tag"; "sift" ] -> (
      match Tag.sift_channel stdin with
      | Error _ -> 1
      | Ok l ->
        l |> List.iter (fun (Tag.Tag s) -> Printf.printf "%s\n" s);
        0)
  | [ _; "activitypub" as cmd ] -> (
      Make.make rz Ap.Person.target
      |> tail cmd
    )
  | _ -> err 2 [ "get help with -h" ]