cage
/
tinmop
mirror of https://codeberg.org/cage/tinmop/
1
0
Fork 0
Code Issues

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

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

39
src/filesystem-utils.lisp
View File

@ -403,30 +403,31 @@
(delete-file-if-exists temporary-file)))
(defmacro with-anaphoric-temp-file ((stream &key (unlink nil)) &body body)
`(let ((temp-file (temporary-file))) ; anaphora
(unwind-protect
(with-open-file (,stream temp-file
:element-type '(unsigned-byte 8)
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
,@body)
,(if unlink
`(delete-file-if-exists temp-file)
nil))))
`(let ((temp-file (temporary-file))) ; anaphora
(unwind-protect
(with-open-file (,stream
temp-file
:element-type '(unsigned-byte 8)
:direction :output
:if-exists :supersede
:if-does-not-exist :create)
,@body)
,(if unlink
`(delete-file-if-exists temp-file)
nil))))
(defparameter *temporary-directories-created* ())
(defun temporary-directory (&optional (temp-parent-directory nil))
(let ((tmpdir (or temp-parent-directory
(os-utils:default-temp-dir))))
(let ((directory-path (if tmpdir
(nix:mkdtemp (format nil "~a~a"
tmpdir
config:+program-name+))
(nix:mkdtemp (format nil "~atmp~a"
*directory-sep*
config:+program-name+)))))
(os-utils:default-temp-dir)))
(directory-path (if tmpdir
(nix:mkdtemp (format nil "~a~a"
tmpdir
config:+program-name+))
(nix:mkdtemp (format nil "~atmp~a"
*directory-sep*
config:+program-name+)))))
(push directory-path *temporary-directories-created*)
directory-path)))

24
src/os-utils.lisp
View File

@ -160,6 +160,30 @@
:error :output)
(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)
(croatoan:end-screen)
(with-input-from-string (stream data)