seppo/lib/cfg.ml

(*
 *    _  _   ____                         _  
 *  _| || |_/ ___|  ___ _ __  _ __   ___ | | 
 * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| | 
 * |_      _|___) |  __/ |_) | |_) | (_) |_| 
 *   |_||_| |____/ \___| .__/| .__/ \___/(_) 
 *                     |_|   |_|             
 *
 * Personal Social Web.
 *
 * 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/>.
 *)

let cgi = "seppo.cgi"

let random_pwd () =
  (* 12*8 bits of entropy packed into 16 legible characters *)
  Random0.random_buffer 12
  |> Cstruct.to_string
  |> Base64.encode_string ~alphabet:Base64.uri_safe_alphabet

module Base = struct
  let fn = "app/etc/baseurl.s"

  let to_file fn u : (string,string) result =
    File.out_channel fn (fun oc ->
        assert (u |> Uri.path |> St.starts_with ~prefix:"/");
        assert (u |> Uri.path |> St.ends_with ~suffix:"/");
        assert (not (u |> Uri.path |> St.ends_with ~suffix:"//"));
        Csexp.Atom (u
                    |> Uri.to_string)
        |> Csexp.to_channel oc;
        Ok fn)

  let from_file =
    File.in_channel' (fun ic ->
        match ic |> Csexp.input with
        | Error _ as e -> e
        | Ok Csexp.Atom b ->
          let b = b |> Uri.of_string in
          assert (match b |> Uri.scheme with
              | Some "http"
              | Some "https" -> true
              | _ -> false);
          assert (b |> Uri.host |> Option.is_some);
          assert (b |> Uri.to_string |> St.ends_with ~suffix:"/");
          assert (not (b |> Uri.path |> St.ends_with ~suffix:"//"));
          assert (b |> Uri.fragment |> Option.is_none);
          assert (b |> Uri.query |> List.length = 0);
          Ok b
        | _ -> Error __LOC__ )
end

module CookieSecret = struct
  let fn = "app/var/run/cookie.s"
  let l32 = 32

  let from_file fn =
    (* Logr.debug (fun m -> m "CookieSecret.from_file: %s" fn); *)
    let ( let* ) = Result.bind in
    File.in_channel fn (fun ic ->
        let* l = match Csexp.input ic with
          | Error _ as e -> e
          | Ok Csexp.Atom s -> Ok s
          | _ -> Error "expected string atom" in
        let l = l |> Cstruct.of_string in
        assert (l32 = (l |> Cstruct.length));
        Ok l)

  let rule : Make.t = {
    target         = fn;
    prerequisites  =  [];
    fresh          = Make.Missing;
    command        = fun _ _ _ ->
      File.out_channel' (fun oc ->
          Logr.debug (fun m -> m "Cfg.CookieSecret.rule: %d bytes of entropy, see Mirage_crypto.Chacha20" l32);
          Csexp.Atom (Random0.random_buffer l32
                      |> Cstruct.to_string)
          |> Csexp.to_channel oc;
          Ok "")
  }

  let make pre = Make.make ~pre [rule] fn
end

module Profile = struct
  type t = {
    title    : string; (* similar atom:subtitle *)
    bio      : string; (* similar atom:description *)
    language : Rfc4287.rfc4646;
    timezone : Timedesc.Time_zone.t;
    posts_per_page : int;
  }

  let validate p : (t, 'a) result =
    Ok p

  let encode p =
    let Rfc4287.Rfc4646 language = p.language in
    let tz  : string = p.timezone |> Timedesc.Time_zone.name in
    let ppp : string = p.posts_per_page |> string_of_int in
    Csexp.(List [
        List [ Atom "title";     Atom p.title ] ;
        List [ Atom "bio";       Atom p.bio ] ;
        List [ Atom "language";  Atom language ] ;
        List [ Atom "timezone";  Atom tz ] ;
        List [ Atom "posts-per-page"; Atom ppp ] ;
      ])

  let decode = function
    | Ok Csexp.(List [
        List [ Atom "title";     Atom title ] ;
        List [ Atom "bio";       Atom bio ] ;
        List [ Atom "language";  Atom language ] ;
        List [ Atom "timezone";  Atom timezone ] ;
        List [ Atom "posts-per-page"; Atom posts_per_page ] ;
      ]) ->
      {
        title;
        bio;
        language = Rfc4287.Rfc4646 language;
        timezone = Timedesc.Time_zone.(timezone |> make |> Option.value ~default:Rfc3339.fallback);
        posts_per_page = posts_per_page |> int_of_string;
      }
      |> validate
    | Ok _ -> Error "profile field expectation failure"
    | Error _ as e -> e

  let from_file fn =
    try fn |> File.in_channel' Csexp.input
        |> decode
    with
    | e ->
      Logr.err (fun m -> m "%s %s" __LOC__ (Printexc.to_string e));
      Error "failed to load profile from file"

  let to_file fn (p : t) =
    Logr.debug (fun m -> m "to_file '%s' ('%s')" fn p.title);
    File.out_channel fn (fun oc ->
        p
        |> encode
        |> Csexp.to_channel oc;
        Ok fn )

  let fn = "app/etc/profile.s"

  let load
      ?(tz = Rfc3339.fallback)
      fn : t =
    let defa posts_per_page timezone : t =
      let language = Rfc4287.Rfc4646 "en"
      and title = "Yet Another #Seppo! 🌻"
      and bio = {|#Seppo — Personal Social Web. For you!

Hooray! You successfully put the file seppo.cgi from https://Seppo.Social/en/support/#installation on your webspace, visited it and are now enjoying networking in the fediverse!

#Seppo is an https://W3.org/TR/ActivityPub fediverse server software of unsurpassed sustainability and respects the https://permacomputing.net/Principles/. It has a minimal resource and carbon footprint and is built to work for decades without maintenance. Shared webspace is sufficient, no privileged access ('root') required. The seppo.cgi is active only in the moments you are sending and receiving posts. Your casual visitors won't ever use it. They get static files from your webspace. By renting that, your provider cares for security and you may sleep untroubled!

CGIs entered the stage 1997 and drove the dotcom boom. Later on they got a bad name, mostly because they don't scale well to big numbers and can't serve millions of users at a time. Many younger developers are unaware of them. However, you are not a million users, you are just one! A CGI can very well serve one, it even has favourable security properties in this case. And remember, your visitors won't use the CGI.|}
      in {title;bio;language;timezone;posts_per_page}
    in
    match from_file fn with
    | Ok p -> p
    | Error e ->
      Logr.warn (fun m -> m "%s.%s: %s" "Cfg.Profile" "load" e);
      defa
        50
        tz

  let ban = "app/var/lib/me-banner.jpg" |> Make.copy "me-banner.jpg"
  let ava = "app/var/lib/me-avatar.jpg" |> Make.copy "me-avatar.jpg"
end

module Urlcleaner = struct

  let fn = "app/etc/url-cleaner.s"

  type t = {
    rex : string;
    rep : string;
  }

  let is_valid v : (t, 'a) result = Ok v

  let of_file _fn =
    Error "not implemented yet"

  let apply' _c _s =
    Error "not implemented yet"

  let apply _l _s =
    Error "not implemented yet"
end