Changeset 36870 in project


Ignore:
Timestamp:
11/23/18 14:31:36 (2 weeks ago)
Author:
chust
Message:

[openssl] Support to load verification roots from wherever OpenSSL sees fit

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/5/openssl/trunk/openssl.scm

    r36597 r36870  
    787787;; load trusted root certificates into SSL context
    788788(define (ssl-load-verify-root-certificates! obj pathname #!optional (dirname #f))
    789   (if pathname (##sys#check-string pathname))
    790   (if dirname (##sys#check-string dirname))
    791   (ssl-clear-error)
    792   (unless (eq?
    793            ((foreign-lambda
    794              int "SSL_CTX_load_verify_locations" c-pointer c-string c-string)
    795             (ssl-unwrap-context obj)
    796             (if pathname pathname #f)
    797             (if dirname dirname #f))
    798            1)
    799     (ssl-abort 'ssl-load-verify-root-certificates! #f pathname dirname)))
     789  (unless (boolean? pathname) (##sys#check-string pathname))
     790  (unless (boolean? dirname) (##sys#check-string dirname))
     791  (ssl-clear-error)
     792  (if (and (eq? pathname #t) (eq? dirname #t))
     793    (unless (eq?
     794             ((foreign-lambda
     795               int "SSL_CTX_set_default_verify_paths" c-pointer)
     796               (ssl-unwrap-context obj))
     797             1)
     798      (ssl-abort 'ssl-load-verify-root-certificates! #f pathname dirname)))
     799    (unless (eq?
     800             ((foreign-lambda
     801               int "SSL_CTX_load_verify_locations" c-pointer c-string c-string)
     802              (ssl-unwrap-context obj) pathname dirname)
     803             1)
     804      (ssl-abort 'ssl-load-verify-root-certificates! #f pathname dirname)))
    800805
    801806;; load suggested root certificates into SSL context
     
    854859
    855860(define ssl-default-certificate-authorities
    856   (make-parameter
    857    (cond-expand
    858     (macosx "/opt/local/etc/openssl/cert.pem")
    859     (else #f))))
     861  (make-parameter #t))
    860862
    861863(define ssl-default-certificate-authority-directory
    862   (make-parameter
    863    (cond-expand
    864     (unix "/etc/ssl/certs")
    865     (else "certs"))))
     864  (make-parameter #t))
    866865
    867866(define (ssl-make-client-context* #!key (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? #t))
    868   (unless (or certificate-authorities certificate-authority-directory)
    869     (set! certificate-authority-directory (ssl-default-certificate-authority-directory))
     867  (unless certificate-authorities
    870868    (set! certificate-authorities (ssl-default-certificate-authorities)))
     869  (unless certificate-authority-directory
     870    (set! certificate-authority-directory (ssl-default-certificate-authority-directory)))
    871871  (let ((ctx (ssl-make-client-context protocol)))
    872872    (ssl-set-cipher-list! ctx cipher-list)
     
    882882
    883883(define (ssl-listen* #!key hostname (port 0) (backlog 4) (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? #f))
    884   (unless (or certificate-authorities certificate-authority-directory)
    885     (set! certificate-authorities (ssl-default-certificate-authorities))
     884  (unless certificate-authorities
     885    (set! certificate-authorities (ssl-default-certificate-authorities)))
     886  (unless certificate-authority-directory
    886887    (set! certificate-authority-directory (ssl-default-certificate-authority-directory)))
    887888  (let ((ear (ssl-listen port backlog hostname protocol)))
     
    889890    (ssl-load-certificate-chain! ear certificate)
    890891    (ssl-load-private-key! ear private-key private-key-type private-key-asn1?)
    891     (when certificate-authorities
     892    (when (string? certificate-authorities)
    892893      (ssl-load-suggested-certificate-authorities! ear certificate-authorities))
    893894    (ssl-load-verify-root-certificates! ear certificate-authorities certificate-authority-directory)
     
    896897
    897898(define (ssl-start* server? tcp-in tcp-out #!key (protocol 'tlsv12) (cipher-list "DEFAULT") certificate private-key (private-key-type 'rsa) private-key-asn1? certificate-authorities certificate-authority-directory (verify? (not server?)) sni-name)
    898   (unless (or certificate-authorities certificate-authority-directory)
    899     (set! certificate-authorities (ssl-default-certificate-authorities))
     899  (unless certificate-authorities
     900    (set! certificate-authorities (ssl-default-certificate-authorities)))
     901  (unless certificate-authority-directory
    900902    (set! certificate-authority-directory (ssl-default-certificate-authority-directory)))
    901903  ;; ssl-wrap-client-context only serves a technical purpose here,
     
    906908      (ssl-load-certificate-chain! ctx certificate)
    907909      (ssl-load-private-key! ctx private-key private-key-type private-key-asn1?))
    908     (when certificate-authorities
     910    (when (string? certificate-authorities)
    909911      (ssl-load-suggested-certificate-authorities! ctx certificate-authorities))
    910912    (ssl-load-verify-root-certificates! ctx certificate-authorities certificate-authority-directory)
Note: See TracChangeset for help on using the changeset viewer.