changelog shortlog graph tags branches changeset files revisions annotate raw help

Mercurial > core / lisp/lib/obj/secret.lisp

changeset 698: 96958d3eb5b0
parent: 16fe3cdae1e2
author: Richard Westhaver <ellis@rwest.io>
date: Fri, 04 Oct 2024 22:04:59 -0400
permissions: -rw-r--r--
description: fixes 
     1 ;;; secret.lisp --- Secret (concealed) Objects
     2 
     3 ;; Object wrapper intended to prevent leaking of sensitive data.
     4 
     5 ;;; Commentary:
     6 
     7 ;; ref: https://github.com/rotatef/secret-values
     8 
     9 ;;; Code:
    10 (in-package :obj/secret)
    11 
    12 (defclass secret-object ()
    13   ((name :initform (symbol-name #1=(gensym "secret")) :type string :accessor secret-object-name :initarg :name)
    14    (symbol :initform #1# :type symbol :accessor secret-object-symbol :initarg :symbol)))
    15 
    16 (defmethod print-object ((self secret-object) stream)
    17   (if (secret-object-name self)
    18       (print-unreadable-object (self stream :type t :identity t)
    19         (princ (secret-object-name self) stream))
    20       (print-unreadable-object (self stream :type t :identity t))))
    21 
    22 (defgeneric conceal-object (self &key name &allow-other-keys)
    23   (:documentation"Conceals value into a SECRET object. An optional name can be
    24 provided to aid debugging.")
    25   (:method ((self t) &key name)
    26     (let ((secret (apply #'make-instance 'secret-object `(,@(when name `(:name ,name))
    27                                                           ,@(when name `(:symbol ,(make-symbol name)))))))
    28       (setf (get (secret-object-symbol secret) 'secret) (lambda () self))
    29       secret)))
    30 
    31 
    32 (defgeneric reveal-object (self)
    33   (:documentation "Returns the secret value of SELF. An error of type TYPE-ERROR is
    34  signalled if the argument is not of type SECRET-OBJECT.")
    35   (:method ((self secret-object))
    36     (funcall (get (secret-object-symbol self) 'secret))))
    37 
    38 
    39 (defgeneric ensure-concealed (object &key name &allow-other-keys)
    40   (:documentation "If object is already a of type SECRET-VALUE returns is unaltered,
    41   otherwise conceals it as if by calling CONCEAL-VALUE.")
    42   (:method ((self t) &key name)
    43     (typecase self
    44       (secret-object self)
    45       (t (conceal-object self :name name)))))
    46 
    47 (defgeneric ensure-revealed (object)
    48   (:documentation "If object is type SECRET-VALUE returns the concealed value, otherwise returns object.")
    49   (:method ((self t))
    50     (typecase self
    51     (secret-object (reveal-object self))
    52     (t self))))