cage/tinmop
1
0
Fork 0
mirror of https://codeberg.org/cage/tinmop/ synced 2025-02-17 08:10:36 +01:00
Code Issues

- added function 'os-utils:change-ssl-key-passphrase'.

Browse Source
This commit is contained in:
cage 2024-02-04 14:57:49 +01:00
parent 1b599a539a
commit e458dd8eb9
2 changed files with 44 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
src/filesystem-utils.lisp
View File

@ -405,7 +405,8 @@
(defmacro with-anaphoric-temp-file ((stream &key (unlink nil)) &body body) (defmacro with-anaphoric-temp-file ((stream &key (unlink nil)) &body body)
`(let ((temp-file (temporary-file))) ; anaphora `(let ((temp-file (temporary-file))) ; anaphora
(unwind-protect (unwind-protect
(with-open-file (,stream temp-file (with-open-file (,stream
temp-file
:element-type '(unsigned-byte 8) :element-type '(unsigned-byte 8)
:direction :output :direction :output
:if-exists :supersede :if-exists :supersede
@ -419,8 +420,8 @@
(defun temporary-directory (&optional (temp-parent-directory nil)) (defun temporary-directory (&optional (temp-parent-directory nil))
(let ((tmpdir (or temp-parent-directory (let ((tmpdir (or temp-parent-directory
(os-utils:default-temp-dir)))) (os-utils:default-temp-dir)))
(let ((directory-path (if tmpdir (directory-path (if tmpdir
(nix:mkdtemp (format nil "~a~a" (nix:mkdtemp (format nil "~a~a"
tmpdir tmpdir
config:+program-name+)) config:+program-name+))

24
src/os-utils.lisp
View File

@ -160,6 +160,30 @@
:error :output) :error :output)
(values cert-file key-file))) (values cert-file key-file)))
(defun change-ssl-key-passphrase (keypath old-passphrase new-passphrase)
(fs:with-anaphoric-temp-file (stream :unlink t)
(with-input-from-string (passphrase-stream new-passphrase)
(let* ((cmd-args (format nil
(text-utils:strcat "rsa -aes256 -in ~a -out ~a"
" -passin pass:~a -passout stdin")
keypath
fs:temp-file
old-passphrase
new-passphrase)))
(let ((output-string (misc:make-fresh-array 0 #\a 'character nil)))
(with-output-to-string (output-stream output-string)
(let ((process (run-external-program +openssl-bin+
(text-utils:split-words cmd-args)
:input passphrase-stream
:output output-stream
:error :output
:wait t)))
(if (process-exit-success-p process)
(fs:copy-a-file fs:temp-file keypath :overwrite t)
(error "error changing passphrase for key ~a ~a"
keypath
output-string)))))))))
(defun send-to-pipe (data program-and-args) (defun send-to-pipe (data program-and-args)
(croatoan:end-screen) (croatoan:end-screen)
(with-input-from-string (stream data) (with-input-from-string (stream data)