lib/auth.ml

   1 (*
   2  *    _  _   ____                         _
   3  *  _| || |_/ ___|  ___ _ __  _ __   ___ | |
   4  * |_  ..  _\___ \ / _ \ '_ \| '_ \ / _ \| |
   5  * |_      _|___) |  __/ |_) | |_) | (_) |_|
   6  *   |_||_| |____/ \___| .__/| .__/ \___/(_)
   7  *                     |_|   |_|
   8  *
   9  * Personal Social Web.
  10  *
  11  * auth.ml
  12  *
  13  * Copyright (C) The #Seppo contributors. All rights reserved.
  14  *
  15  * This program is free software: you can redistribute it and/or modify
  16  * it under the terms of the GNU General Public License as published by
  17  * the Free Software Foundation, either version 3 of the License, or
  18  * (at your option) any later version.
  19  *
  20  * This program is distributed in the hope that it will be useful,
  21  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  22  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23  * GNU General Public License for more details.
  24  *
  25  * You should have received a copy of the GNU General Public License
  26  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  27  *)
  28
  29 open Astring
  30
  31 (* Password reset:
  32  *
  33  * delete the file Auth.fn
  34 *)
  35
  36 let  fn = "app/etc/passwd.s"
  37 type uid    = Uid    of string
  38 type bcrypt = Bcrypt of string
  39 let  dummy  = Uid ""
  40
  41 let is_setup = File.exists
  42
  43 let to_file fn (Uid uid, pwd) =
  44   Logr.debug (fun m -> m "to_file '%s' ..." uid);
  45   let h = Bcrypt.hash pwd |> Bcrypt.string_of_hash in
  46   fn |> File.out_channel_replace (fun oc ->
  47       Csexp.(List [ Atom "uid"; Atom uid; Atom "bcrypt"; Atom h ] |> to_channel oc);
  48       Ok fn )
  49
  50 let from_file fn =
  51   fn |> File.in_channel (fun ic ->
  52       let open Csexp in
  53       match input ic with
  54       | Ok List [ Atom "uid"; Atom uid; Atom "bcrypt"; Atom hash ] -> Ok (Uid uid, Bcrypt hash)
  55       | Error _ as e -> e
  56       | _ -> Error "invalid credential store" )
  57
  58 let uid_from_file fn =
  59   Logr.debug (fun m -> m "Auth.uid_from_file");
  60   try
  61     match from_file fn with
  62     | Ok (uid, _) -> Ok uid
  63     | Error _ as e -> e
  64   with
  65   | Sys_error e -> Error e
  66
  67 (* https://opam.ocaml.org/packages/safepass/ *)
  68 let chk (Uid uid', Bcrypt hash') (Uid uid, pwd) =
  69   Logr.debug (fun m -> m "Auth.chk '%s' '%s'" uid "***");
  70   if hash'
  71      |> Bcrypt.hash_of_string
  72      |> Bcrypt.verify pwd
  73   && String.equal uid' uid
  74   then Ok (Uid uid)
  75   else Error "invalid username or password"
  76
  77 let chk_file fn cred =
  78   match from_file fn with
  79   | Ok v -> chk v cred
  80   | Error _ as e -> e
  81
  82 (* https://opam.ocaml.org/packages/safepass/ *)
  83 let verify cred (uid', hash') =
  84   let level = Logs.Debug
  85   and error = Http.s403' in
  86   chk (uid',hash') cred
  87   |> Result.map_error (Http.err500 ~error ~level "Auth.verify")
  88
  89 let verify_file fn cred =
  90   let level = Logs.Debug
  91   and error = Http.s403' in
  92   chk_file fn cred
  93   |> Result.map_error (Http.err500 ~error ~level "Auth.verify_file")
  94