changelog shortlog graph tags branches files raw help

Mercurial > core / changeset: gst and krypt work, added obj/secret

changeset 494: 16fe3cdae1e2
parent 493: cde5360295cd
child 495: 7120877e0453
author: Richard Westhaver <ellis@rwest.io>
date: Sun, 30 Jun 2024 21:33:11 -0400
files: lisp/ffi/gstreamer/debug.lisp lisp/ffi/gstreamer/element-factory.lisp lisp/ffi/gstreamer/gstreamer.asd lisp/ffi/gstreamer/object.lisp lisp/ffi/gstreamer/pkg.lisp lisp/ffi/gstreamer/tests.lisp lisp/lib/krypt/err.lisp lisp/lib/krypt/krypt.lisp lisp/lib/krypt/pkg.lisp lisp/lib/krypt/tests.lisp lisp/lib/obj/obj.asd lisp/lib/obj/pkg.lisp lisp/lib/obj/secret.lisp lisp/lib/vc/vc.lisp skelfile
description: gst and krypt work, added obj/secret
     1.1--- a/lisp/ffi/gstreamer/debug.lisp	Sun Jun 30 20:16:36 2024 -0400
     1.2+++ b/lisp/ffi/gstreamer/debug.lisp	Sun Jun 30 21:33:11 2024 -0400
     1.3@@ -17,3 +17,19 @@
     1.4 (define-alien-routine gst-debug-bin-to-dot-data c-string
     1.5   (bin (* gst-bin))
     1.6   (details gst-debug-graph-details))
     1.7+
     1.8+(define-alien-enum (gst-debug-level int)
     1.9+                   :none 0
    1.10+                   :error 1
    1.11+                   :warning 2
    1.12+                   :fixme 3
    1.13+                   :info 4
    1.14+                   :debug 5
    1.15+                   :log 6
    1.16+                   :trace 7
    1.17+                   :memdump 9
    1.18+                   :level-count 10)
    1.19+
    1.20+(defvar *gst-level-default* (gst-debug-level :none))
    1.21+
    1.22+(defvar *gst-level-max* (gst-debug-level :level-count))
     2.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     2.2+++ b/lisp/ffi/gstreamer/element-factory.lisp	Sun Jun 30 21:33:11 2024 -0400
     2.3@@ -0,0 +1,15 @@
     2.4+;;; element-factory.lisp --- Gstreamer FFI Element Factories
     2.5+
     2.6+;; 
     2.7+
     2.8+;;; Code:
     2.9+(in-package :gstreamer)
    2.10+
    2.11+(define-opaque gst-element-factory)
    2.12+(define-alien-type gst-element-factory-t (struct nil))
    2.13+
    2.14+(define-alien-routine gst-element-factory-get-type gtype)
    2.15+(define-alien-routine gst-element-factory-find (* gst-element-factory) (name c-string))
    2.16+(define-alien-routine gst-element-factory-make (* gst-element)
    2.17+  (factory (* gst-element-factory))
    2.18+  (name c-string))
     3.1--- a/lisp/ffi/gstreamer/gstreamer.asd	Sun Jun 30 20:16:36 2024 -0400
     3.2+++ b/lisp/ffi/gstreamer/gstreamer.asd	Sun Jun 30 21:33:11 2024 -0400
     3.3@@ -12,6 +12,7 @@
     3.4                (:file "bus" :depends-on ("object"))
     3.5                (:file "pad" :depends-on ("object"))
     3.6                (:file "element" :depends-on ("clock" "object" "iterator" "context"))
     3.7+               (:file "element-factory" :depends-on ("element"))
     3.8                (:file "bin" :depends-on ("element"))
     3.9                (:file "debug" :depends-on ("bin"))
    3.10                (:file "play" :depends-on ("element")))
     4.1--- a/lisp/ffi/gstreamer/object.lisp	Sun Jun 30 20:16:36 2024 -0400
     4.2+++ b/lisp/ffi/gstreamer/object.lisp	Sun Jun 30 21:33:11 2024 -0400
     4.3@@ -26,3 +26,12 @@
     4.4           (%gst-reserved gpointer)))
     4.5 
     4.6 (define-opaque gst-object-class)
     4.7+
     4.8+(define-alien-routine gst-object-ref gpointer (object gpointer))
     4.9+(define-alien-routine gst-object-unref void (object gpointer))
    4.10+(define-alien-routine gst-clear-object void (* (* gst-object)))
    4.11+(define-alien-routine gst-object-ref-sink gpointer (object gpointer))
    4.12+(define-alien-routine gst-object-replace boolean (old (* (* gst-object))) (new (* gst-object)))
    4.13+(define-alien-routine gst-object-get-path-string c-string (object (* gst-object)))
    4.14+(define-alien-routine gst-object-check-uniqueness boolean (list (* glist)) (name c-string))
    4.15+
     5.1--- a/lisp/ffi/gstreamer/pkg.lisp	Sun Jun 30 20:16:36 2024 -0400
     5.2+++ b/lisp/ffi/gstreamer/pkg.lisp	Sun Jun 30 21:33:11 2024 -0400
     5.3@@ -12,7 +12,8 @@
     5.4    :gtype :gquark :gtype-interface :gcond
     5.5    :gthread :gdestroy-notify :ghook-list)
     5.6   (:export :gst-version-string :gst-version :gst-init
     5.7-   :gst-init-check :gst-deinit :gst-is-initialized))
     5.8+   :gst-init-check :gst-deinit :gst-is-initialized :gst-element-factory-make
     5.9+   :gst-element-set-state))
    5.10 
    5.11 (in-package :gstreamer)
    5.12 
     6.1--- a/lisp/ffi/gstreamer/tests.lisp	Sun Jun 30 20:16:36 2024 -0400
     6.2+++ b/lisp/ffi/gstreamer/tests.lisp	Sun Jun 30 21:33:11 2024 -0400
     6.3@@ -9,7 +9,8 @@
     6.4 (in-package :gstreamer/tests)
     6.5 (defsuite :gstreamer)
     6.6 (in-suite :gstreamer)
     6.7-
     6.8+(glib:load-glib)
     6.9+(load-gstreamer)
    6.10 (deftest sanity ()
    6.11   (with-alien ((argv (array c-string))
    6.12                (argc (* t))
    6.13@@ -22,3 +23,6 @@
    6.14     (format t "initialized GStreamer: ~A.~A.~A.~A~%" major minor micro nano)
    6.15     (gst-deinit)
    6.16     (println "Shutdown GStreamer")))
    6.17+
    6.18+(deftest basic ()
    6.19+  )
     7.1--- a/lisp/lib/krypt/err.lisp	Sun Jun 30 20:16:36 2024 -0400
     7.2+++ b/lisp/lib/krypt/err.lisp	Sun Jun 30 21:33:11 2024 -0400
     7.3@@ -5,4 +5,11 @@
     7.4 ;;; Code:
     7.5 (in-package :krypt)
     7.6 
     7.7-(deferror krypt-error (std-error) ())
     7.8+(define-condition krypt-error (error)
     7.9+  ()
    7.10+  (:documentation "Error signaled by the KRYPT system."))
    7.11+
    7.12+(deferror krypt-simple-error (krypt-error simple-error) () (:auto t))
    7.13+
    7.14+(defun krypt-simple-error (ctrl &rest args)
    7.15+  (error 'simple-sql-error :format-control ctrl :format-arguments args))
     8.1--- a/lisp/lib/krypt/krypt.lisp	Sun Jun 30 20:16:36 2024 -0400
     8.2+++ b/lisp/lib/krypt/krypt.lisp	Sun Jun 30 21:33:11 2024 -0400
     8.3@@ -15,7 +15,7 @@
     8.4     (format stream "~S ~A" :id (format-sxhash (id self)))))
     8.5 
     8.6 (defun find-krypt-symbol (s)
     8.7-  (find-symbol* (symbol-name s) :homer nil))
     8.8+  (find-symbol* (symbol-name s) :krypt nil))
     8.9 
    8.10 (defmethod load-ast ((self krypt-config))
    8.11   (with-slots (ast) self
    8.12@@ -39,7 +39,7 @@
    8.13                         :exclude exclude)))
    8.14 
    8.15 (defun load-kryptrc (&optional (file *default-user-kryptrc*))
    8.16-  "Load a homerc configuration from FILE. Defaults to ~/.homerc."
    8.17+  "Load a krypt configuration from FILE. Defaults to ~/.kryptrc."
    8.18   (unless (not (probe-file file))
    8.19     (let ((form (file-read-forms file)))
    8.20       (load-ast (make-instance 'krypt-config :ast form :path file :id (sxhash form))))))
     9.1--- a/lisp/lib/krypt/pkg.lisp	Sun Jun 30 20:16:36 2024 -0400
     9.2+++ b/lisp/lib/krypt/pkg.lisp	Sun Jun 30 21:33:11 2024 -0400
     9.3@@ -6,8 +6,13 @@
     9.4 
     9.5 ;; TODO: https://qemu-project.gitlab.io/qemu/system/secrets.html#passing-secrets-via-the-linux-keyring
     9.6 
     9.7+;; The goal of this system is to provide a secrets management tool accessible
     9.8+;; to users and administrators. The MVP is a simple user-space CLI utility
     9.9+;; built on top of the CRY cryptography package and leveraging keyutils.
    9.10+
    9.11 ;;; Code:
    9.12 (defpackage :krypt
    9.13   (:use :cl :std :cry :dat/sxp :obj/id)
    9.14   (:export :krypt-error :*default-user-kryptrc*
    9.15-           :krypt-config :load-kryptrc))
    9.16+           :krypt-config :load-kryptrc
    9.17+           :krypt-error :krypt-simple-error))
    10.1--- a/lisp/lib/krypt/tests.lisp	Sun Jun 30 20:16:36 2024 -0400
    10.2+++ b/lisp/lib/krypt/tests.lisp	Sun Jun 30 21:33:11 2024 -0400
    10.3@@ -11,4 +11,5 @@
    10.4 (defsuite :krypt)
    10.5 (in-suite :krypt)
    10.6 
    10.7-(deftest config ())
    10.8+(deftest config ()
    10.9+  (make-instance 'krypt-config))
    11.1--- a/lisp/lib/obj/obj.asd	Sun Jun 30 20:16:36 2024 -0400
    11.2+++ b/lisp/lib/obj/obj.asd	Sun Jun 30 21:33:11 2024 -0400
    11.3@@ -54,6 +54,7 @@
    11.4                (:file "direction")
    11.5                (:file "shape")
    11.6                (:file "query")
    11.7+               (:file "secret")
    11.8                (:file "db")
    11.9                (:file "cfg")
   11.10                (:file "build"))
    12.1--- a/lisp/lib/obj/pkg.lisp	Sun Jun 30 20:16:36 2024 -0400
    12.2+++ b/lisp/lib/obj/pkg.lisp	Sun Jun 30 21:33:11 2024 -0400
    12.3@@ -384,10 +384,15 @@
    12.4            :column-physical-expression
    12.5            :evaluate))
    12.6 
    12.7+(defpackage :obj/secret
    12.8+  (:nicknames :secret)
    12.9+  (:use :cl :std)
   12.10+  (:export :secret-object :reveal-object :conceal-object :ensure-revealed :ensure-concealed))
   12.11+
   12.12 (defpackage :obj/build
   12.13   (:use :cl :std)
   12.14   (:export :build :build-from))
   12.15 
   12.16 (uiop:define-package :obj
   12.17   (:use-reexport :list :hash :color
   12.18-   :seq :tree :graph :id :db :time :uri :url :cfg :music :temperature :direction :shape))
   12.19+   :seq :tree :graph :id :db :time :uri :url :cfg :music :temperature :direction :shape :secret :query))
    13.1--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
    13.2+++ b/lisp/lib/obj/secret.lisp	Sun Jun 30 21:33:11 2024 -0400
    13.3@@ -0,0 +1,52 @@
    13.4+;;; secret.lisp --- Secret (concealed) Objects
    13.5+
    13.6+;; Object wrapper intended to prevent leaking of sensitive data.
    13.7+
    13.8+;;; Commentary:
    13.9+
   13.10+;; ref: https://github.com/rotatef/secret-values
   13.11+
   13.12+;;; Code:
   13.13+(in-package :obj/secret)
   13.14+
   13.15+(defclass secret-object ()
   13.16+  ((name :initform (symbol-name #1=(gensym "secret")) :type string :accessor secret-object-name :initarg :name)
   13.17+   (symbol :initform #1# :type symbol :accessor secret-object-symbol :initarg :symbol)))
   13.18+
   13.19+(defmethod print-object ((self secret-object) stream)
   13.20+  (if (secret-object-name self)
   13.21+      (print-unreadable-object (self stream :type t :identity t)
   13.22+        (princ (secret-object-name self) stream))
   13.23+      (print-unreadable-object (self stream :type t :identity t))))
   13.24+
   13.25+(defgeneric conceal-object (self &key name &allow-other-keys)
   13.26+  (:documentation"Conceals value into a SECRET object. An optional name can be
   13.27+provided to aid debugging.")
   13.28+  (:method ((self t) &key name)
   13.29+    (let ((secret (apply #'make-instance 'secret-object `(,@(when name `(:name ,name))
   13.30+                                                          ,@(when name `(:symbol ,(make-symbol name)))))))
   13.31+      (setf (get (secret-object-symbol secret) 'secret) (lambda () self))
   13.32+      secret)))
   13.33+
   13.34+
   13.35+(defgeneric reveal-object (self)
   13.36+  (:documentation "Returns the secret value of SELF. An error of type TYPE-ERROR is
   13.37+ signalled if the argument is not of type SECRET-OBJECT.")
   13.38+  (:method ((self secret-object))
   13.39+    (funcall (get (secret-object-symbol self) 'secret))))
   13.40+
   13.41+
   13.42+(defgeneric ensure-concealed (object &key name &allow-other-keys)
   13.43+  (:documentation "If object is already a of type SECRET-VALUE returns is unaltered,
   13.44+  otherwise conceals it as if by calling CONCEAL-VALUE.")
   13.45+  (:method ((self t) &key name)
   13.46+    (typecase self
   13.47+      (secret-object self)
   13.48+      (t (conceal-object self :name name)))))
   13.49+
   13.50+(defgeneric ensure-revealed (object)
   13.51+  (:documentation "If object is type SECRET-VALUE returns the concealed value, otherwise returns object.")
   13.52+  (:method ((self t))
   13.53+    (typecase self
   13.54+    (secret-object (reveal-object self))
   13.55+    (t self))))
    14.1--- a/lisp/lib/vc/vc.lisp	Sun Jun 30 20:16:36 2024 -0400
    14.2+++ b/lisp/lib/vc/vc.lisp	Sun Jun 30 21:33:11 2024 -0400
    14.3@@ -58,3 +58,7 @@
    14.4   (loop for repo in (directory-repos path)
    14.5         do (let ((out (merge-pathnames output (vc-name repo))))
    14.6              (vc-bundle repo out))))
    14.7+
    14.8+(defun update-repo (path &key push (pull t)))
    14.9+
   14.10+(defun update-repos (path &optional push (pull t)))
    15.1--- a/skelfile	Sun Jun 30 20:16:36 2024 -0400
    15.2+++ b/skelfile	Sun Jun 30 21:33:11 2024 -0400
    15.3@@ -1,6 +1,6 @@
    15.4 ;;; skelfile --- CC/core skelfile -*- mode: skel; -*-
    15.5 :name "core"
    15.6-:author "Richard Westhaver <ellis@rwest.io>"
    15.7+:author ("Richard Westhaver" . "ellis@rwest.io>")
    15.8 :version "0.1.0"
    15.9 :license "MPL"
   15.10 :stash ".stash"