Fcalva/chibi-scheme
1
0
Fork 0
mirror of https://github.com/ashinn/chibi-scheme.git synced 2025-07-11 23:17:34 +02:00
Code Issues Projects Releases Packages Wiki Activity Actions

Don't rsa sign packages by default, but do provide digests.

Browse source
This commit is contained in:
Alex Shinn 2015-05-01 21:57:23 +09:00
parent 76ba196fba
commit f958a82028
3 changed files with 14 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

18
lib/chibi/snow/commands.scm
View file

@ -779,7 +779,7 @@
(call-with-input-file package port->bytevector) (call-with-input-file package port->bytevector)
package)) package))
(snowball (maybe-gunzip raw-data)) (snowball (maybe-gunzip raw-data))
(digest (digest-func snowball)) (digest (delay (digest-func snowball)))
(keys (call-with-input-file (keys (call-with-input-file
(or (conf-get cfg 'key-file) (or (conf-get cfg 'key-file)
(string-append (conf-get-snow-dir cfg) "/priv-key.scm")) (string-append (conf-get-snow-dir cfg) "/priv-key.scm"))
@ -787,25 +787,29 @@
(email (or (conf-get cfg 'email) (email (or (conf-get cfg 'email)
(assoc-get (car keys) 'email))) (assoc-get (car keys) 'email)))
(rsa-key-sexp (find (rsa-identity=? email) keys)) (rsa-key-sexp (find (rsa-identity=? email) keys))
(rsa-key (extract-rsa-private-key rsa-key-sexp))) (rsa-key (extract-rsa-private-key rsa-key-sexp))
(use-rsa? (and rsa-key (conf-get cfg 'sign-uploads?))))
(append (append
`(signature `(signature
(email ,email)) (email ,email))
(if (and rsa-key (conf-get cfg 'sign-uploads?)) (if (or use-rsa?
(not (conf-get cfg 'skip-digest?)))
`((digest ,digest-name)
(,digest-name ,(force digest)))
'())
(if use-rsa?
(let* ((sig (fast-eval (let* ((sig (fast-eval
`(rsa-sign (make-rsa-key ,(rsa-key-bits rsa-key) `(rsa-sign (make-rsa-key ,(rsa-key-bits rsa-key)
,(rsa-key-n rsa-key) ,(rsa-key-n rsa-key)
#f #f
,(rsa-key-d rsa-key)) ,(rsa-key-d rsa-key))
;;,(hex-string->integer digest) ;;,(hex-string->integer digest)
,(hex-string->bytevector digest)) ,(hex-string->bytevector (force digest)))
'((chibi crypto rsa)))) '((chibi crypto rsa))))
(hex-sig (if (bytevector? sig) (hex-sig (if (bytevector? sig)
(bytevector->hex-string sig) (bytevector->hex-string sig)
(integer->hex-string sig)))) (integer->hex-string sig))))
`((digest ,digest-name) `((rsa ,hex-sig)))
(,digest-name ,digest)
(rsa ,hex-sig)))
'())))) '()))))
(define (command/sign cfg spec package) (define (command/sign cfg spec package)

1
lib/chibi/snow/commands.sld
View file

@ -19,6 +19,7 @@
(scheme char) (scheme char)
(scheme eval) (scheme eval)
(scheme file) (scheme file)
(scheme lazy)
(scheme load) (scheme load)
(scheme process-context) (scheme process-context)
(scheme time) (scheme time)

2
tools/snow-chibi
View file

@ -62,8 +62,10 @@
(ignore-signature? boolean ("ignore-sig" "ignore-signature") (ignore-signature? boolean ("ignore-sig" "ignore-signature")
"don't verify package signatures") "don't verify package signatures")
(ignore-digest? boolean ("ignore-digest") "don't verify package checksums") (ignore-digest? boolean ("ignore-digest") "don't verify package checksums")
(skip-digest? boolean ("skip-digest") "don't provide digests without rsa")
(skip-version-checks? boolean ("skip-version-checks") (skip-version-checks? boolean ("skip-version-checks")
"don't verify implementation versions") "don't verify implementation versions")
(sign-uploads? boolean ("sign-uploads") "sign with the rsa key if present")
(host string "base uri of snow repository") (host string "base uri of snow repository")
(repository-uri string "uri of snow repository file") (repository-uri string "uri of snow repository file")
(local-root-repository dirname "repository cache dir for root") (local-root-repository dirname "repository cache dir for root")