Coverage report: /home/ellis/comp/core/app/krypt/krypt.lisp

KindCoveredAll%
expression0118 0.0
branch012 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; krypt/krypt.lisp --- Krypt API
2
 
3
 ;;
4
 
5
 ;;; Code:
6
 (in-package :krypt)
7
 
8
 ;;; Vars
9
 (defparameter *kryptrc* (merge-pathnames ".kryptrc" (user-homedir-pathname)))
10
 (defvar *krypt-directory* (merge-pathnames ".stash/krypt/" (user-homedir-pathname)))
11
 (defvar *krypt-key-directory* (merge-pathnames "keys/" *krypt-directory*))
12
 (defvar *krypt-token-directory* (merge-pathnames "keys/" *krypt-directory*))
13
 (defvar *krypt-password-directory* (merge-pathnames "keys/" *krypt-directory*))
14
 (defvar *krypt-net-directory* (merge-pathnames "net/" *krypt-directory*))
15
 (defvar *krypt-user-config* nil)
16
 
17
 ;;; Config
18
 (defconfig krypt-config (ast id)
19
   ((path :initform nil :initarg :path :type (or pathname null))
20
    (keyrings :initform nil :initarg :keyrings)
21
    (passwords :initform *krypt-password-directory* :initarg :passwords)
22
    (tokens :initform *krypt-token-directory* :initarg :tokens)
23
    (keys :initform *krypt-key-directory* :initarg :keys)
24
    #| gpg, ssh |#
25
 ))
26
 
27
 (defmethod print-object ((self krypt-config) stream)
28
   (print-unreadable-object (self stream :type t)
29
     (format stream "~S ~A" :id (format-sxhash (id self)))))
30
 
31
 (defun find-krypt-symbol (s)
32
   (find-symbol* (symbol-name s) :krypt nil))
33
 
34
 (defmethod load-ast ((self krypt-config))
35
   (with-slots (ast) self
36
     (if (formp ast)
37
         ;; ast is valid, modify object, set ast nil
38
         (progn
39
           (sb-int:doplist (k v) ast
40
             (when-let ((s (find-krypt-symbol k)))
41
               (setf (slot-value self s) v))) ;; needs to be correct package
42
           (setf (ast self) nil)
43
           (with-slots (passwords tokens keys) self
44
             (when (stringp passwords)
45
               (setf (slot-value self 'passwords) 
46
                     (pathname (ensure-directories-exist passwords))))
47
             (when (stringp tokens) 
48
               (setf (slot-value self 'tokens) 
49
                     (pathname (ensure-directories-exist tokens))))
50
             (when (stringp keys) 
51
               (setf (slot-value self 'keys) 
52
                     (pathname (ensure-directories-exist keys)))))
53
           self)
54
         ;; invalid ast, signal error
55
         (error 'syntax-error))))
56
 
57
 (defmethod build-ast ((self krypt-config) &key (nullp nil) (exclude '(ast id)))
58
   (setf (ast self)
59
          (unwrap-object self
60
                         :slots t
61
                         :methods nil
62
                         :nullp nullp
63
                         :exclude exclude)))
64
 
65
 (defun load-kryptrc (&optional (file *kryptrc*))
66
   "Load a krypt configuration from FILE. Defaults to ~/.kryptrc."
67
   (unless (not (probe-file file))
68
     (let ((form (file-read-forms file)))
69
       (load-ast (make-instance 'krypt-config :ast form :path file :id (sxhash form))))))
70
 
71
 (defun init-krypt ()
72
   "Initialize the global KRYPT environment:
73
 
74
 *KRYPT-USER-CONFIG*"
75
   (mapc 'ensure-directories-exist 
76
         (list *krypt-directory* *krypt-net-directory*
77
               *krypt-token-directory* *krypt-password-directory*))
78
   (setq *krypt-user-config* (load-kryptrc))
79
   (values))