letsencrypt-old.tcl
Does not contain a contract.
- Location:
- /packages/acs-subsite/www/admin/letsencrypt-old.tcl
Related Files
[ hide source ] | [ make this the default ]
File Contents
# # letsencrypt.tcl -- # # A small Let's Encrypt client for NaviServer implemented in Tcl. # To use it, set enabled to 1 and drop it somewhere under # NaviServer pageroot which is usually /usr/local/ns/pages and point # browser to it. # # # If this page needs to be restricted, configure the following three variables: # set user "" set password "" set enabled 1 namespace eval ::letsencrypt { # # The certificate will be placed finally into the following # directory: # set sslpath "[ns_info home]/modules/nsssl" # # Let's encrypt has several rate limits to avoid DOS # situations: https://letsencrypt.org/docs/rate-limits/ # # When developing the interface (e.g. improving this script), you # might consider using the staging API of letsencrypt instead of # the production API to void these constraints. # set API "production" #set API "staging" } ########################################################################## # # ---- no configuation below this point --------------------------------- # ########################################################################## package require json package require pki package require nx namespace eval ::letsencrypt { nx::Class create ::letsencrypt::Client { :variable domains :variable domain :variable sans :variable startUrl # crypto state :variable rsa_key :variable modulus :variable exponent # results from last HTTP request :variable nonce :variable replyHeaders :variable replyText # name of final certificate :variable certPrivKey :variable certPemFile # ####################### # # ----- domain form ----- # # ####################### # :method domainForm {} { ns_return 200 text/html [subst { <head> <title>Let's Encrypt Client</title> </head> <body> <form method='post' action='[ns_conn url]'> Please enter the domain names for the SSL certificate:<br> <input name="domains" size="80"> <input type='submit' value='Submit'> </form> </body> }] } # ####################### # # ----- printHeaders ---- # # ####################### # :method printHeaders {headers} { set result "<pre>" foreach {k v} [ns_set array $headers] { append result " $k: [ns_quotehtml $v]\n" } append result "</pre>\n" } # ####################### # # ------- readFile ------ # # ####################### # :method readFile {{-binary:switch f} fileName} { set F [open $fileName r] if {$binary} { fconfigure $F -translation binary } set content [read $F] close $F return $content } # ####################### # # ------- writeFile ----- # # ####################### # :method writeFile {{-binary:switch f} {-append:switch f} fileName content} { set mode [expr {$append ? "a" : "w"}] set F [open $fileName $mode] if {$binary} { fconfigure $F -translation binary } puts -nonewline $F $content close $F } # ################################# # # ----- produce backup files ----- # # ################################# # :method backup {{-mode rename} fileName} { set backupFileName "" if {[file exists $fileName]} { # # If the base file exists, make a backup based on the # content (using a sha256 checksum). Using checksums is # independent of timestamps and makes sure to prevent loss # of data (e.g. config files). If we have already a backup # file, there is nothing to do. # set backupFileName $fileName.[ns_md file -digest sha256 $fileName] if {![file exists $backupFileName]} { file $mode -force $fileName $backupFileName ns_write "Make backup of $fileName<br>" } } else { # # No need to make a backup, file does not exist yet # } return $backupFileName } # ################################# # # ----- base64url converting ----- # # ################################# # :method base64url {data} { return [string map {+ - / _ = {} \n {}} [ns_base64encode $data]] } # ############################## # # ----- JSON web signature ----- # # ############################## # :method JWS {payload} { # # Generate JSON Web Signature (JWS) according to RFC 7515 # based on instance variables nonce, modulus, and # exponent. # set jwk [subst {{ "kty": "RSA", "n": "${:modulus}", "e": "${:exponent}" }}] # build protected header set protected [subst {{"nonce": "${:nonce}"}}] set protected64 [:base64url $protected] # build payload and input for signature set payload64 [:base64url $payload] set siginput [subst {$protected64.$payload64}] # build signature set signature [pki::sign $siginput ${:rsa_key} sha256] set signature64 [:base64url $signature] # build json web signature set jws [subst {{ "header": { "alg": "RS256", "jwk": $jwk }, "protected": "$protected64", "payload": "$payload64", "signature": "$signature64" }}] #ns_log notice "JWS payload:\n$payload\njws:\n$jws" return $jws } # ###############ääää########################## # # ----- post JWS request of given payload ----- # # ############################################# # :method postJwsRequest {url payload} { set queryHeaders [ns_set create] set :replyHeaders [ns_set create] ns_set update $queryHeaders "Content-type" "application/jose+json" # submit post request set id [ns_http queue -method POST -headers $queryHeaders -body [:JWS $payload] $url] ns_http wait -timeout 10 -status S -result :replyText -headers ${:replyHeaders} $id # keep the nonce for the next request set :nonce [ns_set iget ${:replyHeaders} "replay-nonce"] # return status return $S } :method abortMsg {status msg} { ns_write "$msg ended with HTTP status $status<br>" ns_write "[:printHeaders ${:replyHeaders}]<br>${:replyText}<br>" } :method startOfReport {} { ns_headers 200 text/html ns_write {<html lang="en"><head><title>NaviServer Let's Encrypt client</title></head><body>} ns_write "<h3>Obtaining a certificate from Let's Encrypt using \ the [string totitle $::letsencrypt::API] API:</h3>" } :method URL {kind} { dict get ${:apiURLs} $kind } # ###################################äää#### # # ----- get API urls from Let's encrypt ---- # # ########################################## # :method getAPIurls {config} { set url [dict get $config $::letsencrypt::API url] set :replyHeaders [ns_set create] set id [ns_http queue $url] ns_http wait -status S -result R -headers ${:replyHeaders} $id #ns_write [:printHeaders ${:replyHeaders}] set :nonce [ns_set iget ${:replyHeaders} "replay-nonce"] set :apiURLs [json::json2dict $R] ns_write [subst {<br> Let's Encrypt URLs:<br> <pre> [:URL key-change]\n [:URL new-authz]\n [:URL new-cert]\n [:URL new-reg]\n [:URL revoke-cert]</pre> }] } # ########################################## # # - register new acccount at Let's Encrypt - # # ########################################## # :method registerNewAccount {config} { ns_write "Register new account at Let's Encrypt... " ns_write "generating RSA key pair...<br>" # # Repeat max 10 times until registration was successful # for {set count 0} {$count < 10} {incr count} { set :rsa_key [pki::rsa::generate 2048] set :modulus [:base64url [::pki::_dec_to_ascii [dict get ${:rsa_key} n]]] set :exponent [:base64url [::pki::_dec_to_ascii [dict get ${:rsa_key} e]]] # ##################### # # ----- get nonce ----- # # ##################### # set :replyHeaders [ns_set create] set id [ns_http queue -method HEAD [:URL new-reg]] ns_http wait -status S -result R -headers ${:replyHeaders} $id set :nonce [ns_set iget ${:replyHeaders} "replay-nonce"] # ######################## # # ----- registration ----- # # ######################## # ns_write "Creating new registration...<br>" #ns_log notice "REGISTRATION:" set payload [subst {{"resource": "new-reg", "contact": \["mailto:webmaster@${:domain}"\]}}] set status [:postJwsRequest [:URL new-reg] $payload] if {$status eq "400"} { ns_write "Registration failed: ${:replyText}.<br>Retry and generate new RSA key pair...<br>" } else { break } } ns_write "Registration ended with status $status.<br>" return $status } # ########################## # # ----- sign agreement ----- # # ########################## # :method signAgreement {} { ns_write "<br>Signing agreement... " set location [ns_set iget ${:replyHeaders} "location"] # # parse link header for terms of service # set url "" foreach {key value} [ns_set array ${:replyHeaders}] { if {$key eq "link" && [regexp {^<(.*)>;rel="terms-of-service"} $value . url] } { break } } set payload [subst {{"resource": "reg", "agreement": "$url"}}] set httpStatus [:postJwsRequest $location $payload] ns_write "returned HTTP status $httpStatus<br>" return $httpStatus } # ########################## # # ----- authorize domain --- # # ########################## # :method authorizeDomain {domain} { ns_write "<br>Authorizing account for domain <strong>$domain</strong>... " set payload [subst {{"resource": "new-authz", "identifier": {"type": "dns", "value": "$domain"}}}] set httpStatus [:postJwsRequest [:URL new-authz] $payload] ns_write "returned HTTP status $httpStatus<br>" ns_write "json REPLY<br>${:replyText}<br>" ns_write "... getting HTTP challenge... " set :authorization [ns_set iget ${:replyHeaders} "location"] set challenges [dict get [json::json2dict ${:replyText}] challenges] # # parse HTTP challenge # foreach entry $challenges { if {[dict filter $entry value "http-01"] ne ""} { set url [dict get $entry uri] set token [dict get $entry token] } } # # generate thumbprint # set pk [subst {{"e":"${:exponent}","kty":"RSA","n":"${:modulus}"}}] set thumbprint [binary format H* [ns_md string -digest sha256 $pk]] set thumbprint64 [:base64url $thumbprint] # # provide HTTP resource to fulfill HTTP challenge # file mkdir [ns_server pagedir]/.well-known/acme-challenge :writeFile [ns_server pagedir]/.well-known/acme-challenge/$token $token.$thumbprint64 set payload [subst {{"resource": "challenge", "keyAuthorization": "$token.$thumbprint64"}}] set httpStatus [:postJwsRequest $url $payload] ns_write "returned HTTP status $httpStatus<br>" # # ----- validate # ns_write "... validating the challenge... " regexp {^<(.*)>;rel="up"} [ns_set iget ${:replyHeaders} "link"] . url set status [dict get [json::json2dict ${:replyText}] status] ns_write "status: $status<br>" #ns_write "<pre>$result</pre>[:printHeaders ${:replyHeaders}]<br>" # check until validation is finished while {$status eq "pending"} { ns_write "... retry after one second... " ns_sleep 1 set id [ns_http queue $url] ns_http wait -status S -result R -headers ${:replyHeaders} $id set :nonce [ns_set iget ${:replyHeaders} "replay-nonce"] set status [dict get [json::json2dict $R] status] ns_write "status: $status<br>" if {$status ni {"valid" "pending"}} { ns_write "<pre>$R</pre>[:printHeaders ${:replyHeaders}]<br>" break } } return $status } # ########################### # # ----- get certificate ----- # # ########################### # :method certificateRequest {} { ns_write "<br>Generating RSA key pair for SSL certificate... " # # Repeat max 10 times until certificate was successfully obtained # for {set count 0} {$count < 10} {incr count} { set csrViaOpenSLL 1 if {$csrViaOpenSLL} { set csrConfFile $::letsencrypt::sslpath/${:domain}.csr.conf set csrFile $::letsencrypt::sslpath/${:domain}.csr set keyFile $::letsencrypt::sslpath/${:domain}.key exec -ignorestderr openssl genrsa -out $keyFile 2048 set :certPrivKey [:readFile $keyFile] file copy -force /etc/ssl/openssl.cnf $csrConfFile if {[llength ${:sans}] > 0} { set altNames {}; foreach alt ${:sans} {lappend altNames DNS:$alt} :writeFile -append $csrConfFile "\n\[SAN\]\nsubjectAltName=[join $altNames ,]\n" set extensions [list -reqexts SAN -extensions SAN] } else { set extensions {} } exec openssl req -new -sha256 -outform DER {*}$extensions \ -subj "/CN=${:domain}" -key $keyFile -config $csrConfFile -out $csrFile set csr [:readFile -binary $::letsencrypt::sslpath/${:domain}.csr] } else { set cert_key [pki::rsa::generate 2048] set csr [pki::pkcs::create_csr $cert_key [list CN ${:domain}] 0] set :certPrivKey [pki::key $cert_key] } set csr64 [:base64url $csr] set payload [subst {{"resource": "new-cert", "csr": "$csr64", "authorizations": "${:authorization}"}}] ns_write "DONE<br>" ns_write "Getting the certificate for domain ${:domain}, SANs ${:sans}... " set httpStatus [:postJwsRequest [:URL new-cert] $payload] ns_write "returned HTTP status $httpStatus<br>" if {$httpStatus eq "400"} { ns_write "Certificate request failed. Generating new RSA key pair... " #ns_log notice "CSR-Request returned 400\n" ns_write "[:printHeaders ${:replyHeaders}]<br>${:replyText}<br>" } else { break } } return $httpStatus } # ############################### # # ----- install certificate ----- # # ############################### # :method certificateInstall {} { ns_write "<br>Generate the certificate under $::letsencrypt::sslpath...<br>" ns_log notice "Storing certificate under $::letsencrypt::sslpath/${:domain}.cer" :writeFile -binary $::letsencrypt::sslpath/${:domain}.cer ${:replyText} puts "Converting the certificate to PEM format to $::letsencrypt::sslpath/${:domain}.crt" exec openssl x509 -inform der \ -in $::letsencrypt::sslpath/${:domain}.cer \ -out $::letsencrypt::sslpath/${:domain}.crt set cert [:readFile $::letsencrypt::sslpath/${:domain}.crt] # # Build certificate in the file system. Backup old file if necessary. # set :certPemFile $::letsencrypt::sslpath/${:domain}.pem :backup ${:certPemFile} # Save certificate and private key in single file in directory # of nsssl module ns_log notice "Combining certificate and private key to ${:certPemFile}" :writeFile ${:certPemFile} "$cert${:certPrivKey}" ns_log notice "Deleting ${:domain}.cer and ${:domain}.crt under $::letsencrypt::sslpath/" file delete $::letsencrypt::sslpath/${:domain}.cer file delete $::letsencrypt::sslpath/${:domain}.crt # # Get certificate chain; the Let's Encrypt certificates are # available from https://letsencrypt.org/certificates/ # the used certificate is the "Let’s Encrypt Authority X3 (IdenTrust cross-signed)" # # One might as well add the following certificate to complete # the chain, but thos does not seem necessary by # www.ssllabs.com # # https://www.identrust.com/certificates/trustid/root-download-x3.html # ns_write "Obtaining certificate chain ... " set id [ns_http queue https://letsencrypt.org/certs/lets-encrypt-x3-cross-signed.pem.txt] ns_http wait -status S -result R $id ns_write "returned HTTP status $S<br>" :writeFile -append ${:certPemFile} $R # # Add DH parameters # ns_write "Adding DH parameters to ${:certPemFile} (might take a while) ... " exec -ignorestderr -- openssl dhparam 2048 >> ${:certPemFile} 2> /dev/null ns_write " DONE<br><br>" ns_write "New certificate successfully installed in: <strong>${:certPemFile}</strong><br><br>" } # ############################### # # ----- Update configuration ---- # # ############################### # :method updateConfiguration {} { # # Update the NaviServer config file by reading its content # and update it in memory before writing it back to disk # (if changed). # ns_write "Checking the NaviServer config file: " set C [:readFile [ns_info config]] set origConfig $C # # Check, if nsssl module is already loaded # set nssslLoaded 0 foreach d [ns_driver info] { if {[dict get $d protocol] eq "https"} { set nssslLoaded 1 break } } if {$nssslLoaded} { ns_write "The nsssl driver module is apparently already loaded.<br>" } else { ns_write "The nsssl driver module is apparently already not loaded, try to fix this.<br>" if {[regexp {\#\s+ns_param\s+nsssl.*nsssl[.]so} $C]} { # # The nsssl driver is apparently commented out, activate it # regsub {\#(\s+ns_param\s+nsssl.*nsssl[.]so)} $C \1 C ns_write {...removing comment from driver module nsssl.so line in config file.<br>} } else { # # There is no nsssl driver in the config file, add it # to the end. # append C { ns_section ns/server/${server}/modules ns_param nsssl nsssl.so } ns_write {... adding driver module nsssl.so to your config file.<br>} } } if {![regexp {ns_param\s+certificate\s+} $C]} { ns_write [subst {Your config file [ns_info config] does not seem to contain a nsssl definition section.<br> Adding a default section to the end. Please check, if you want to modify the section according to your needs. }] append C [subst { ns_section ns/server/\${server}/module/nsssl ns_param certificate ${:certPemFile} ns_param address 0.0.0.0 ns_param port 443 ns_param ciphers "ECDH+AESGCM:DH+AESGCM:ECDH+AES256:DH+AES256:ECDH+AES128:DH+AES:ECDH+3DES:DH+3DES:RSA+AESGCM:RSA+AES:RSA+3DES:!aNULL:!MD5:!RC4" ns_param protocols "!SSLv2:!SSLv3" ns_param verify 0 ns_param extraheaders { Strict-Transport-Security "max-age=31536000; includeSubDomains" X-Frame-Options SAMEORIGIN X-Content-Type-Options nosniff } }] } elseif {![regexp "ns_param\\s+certificate\\s+${:certPemFile}" $C]} { ns_write {... updating the certificate entry<br>} regsub -all {ns_param\s+certificate\s+[^\n]+} $C "ns_param certificate ${:certPemFile}" C } # # Rewrite config file only, when the content has changed # if {$origConfig ne $C} { # # Make first a backup of old config file ... # :backup -mode copy [ns_info config] # # Rewrite config file # :writeFile [ns_info config] $C ns_write [subst { Updating NaviServer config file<br> Please check updated config file: <strong>[ns_info config]</strong> <br>and update it (if necessary)<p> }] } else { # # Nothing has changed. # ns_write {No need to update the NaviServer config file.<br>} } } # ########################## # # ----- MAIN METHOD ----- # # ########################## # :public method getCertificate {} { set :domains [ns_queryget domains] # # If the domain names were already submitted in the form # (or via query parameters), we have all data we # need. Otherwise give the user a form to fill in the data # and to continue from there. if {${:domains} eq ""} { :domainForm return } set :domain [lindex ${:domains} 0] set :sans [lrange ${:domains} 1 end] set :startUrl "[ns_conn proto]://${:domain}[ns_conn url]" set config { staging {url https://acme-staging.api.letsencrypt.org/directory} production {url https://acme-v01.api.letsencrypt.org/directory} } # # Make sure, the sslpath exists # file mkdir $::letsencrypt::sslpath set signatureKeyFile $::letsencrypt::sslpath/${:domain}.$::letsencrypt::API-account-signature.key # # Start output # :startOfReport # # Always get first the API urls # :getAPIurls $config # # Create or reuse an account # if {[file exists $signatureKeyFile]} { # # We have already registered in the past successfully at # Let's Encrypt and signed the agreement. # ns_write "Reuse existing account registration at Let's Encrypt<br>" eval [:readFile $signatureKeyFile] set :rsa_key $rsa_key set :modulus [:base64url [::pki::_dec_to_ascii [dict get ${:rsa_key} n]]] set :exponent [:base64url [::pki::_dec_to_ascii [dict get ${:rsa_key} e]]] } else { set status [:registerNewAccount $config] if {$status >= 400} { :abortMsg $status "Registration" return } set status [:signAgreement] if {$status >= 400} { :abortMsg $status "Agreement" return } :writeFile $signatureKeyFile [list set rsa_key ${:rsa_key}]\n } # # Authorize and validate domains for this account # file delete -force [ns_server pagedir]/.well-known file mkdir [ns_server pagedir]/.well-known foreach domain ${:domains} { set status [:authorizeDomain $domain] if {$status eq "invalid"} { ns_write [subst { Validation of domain $domain failed. <p>Please restart the procedure at <a href="${:startUrl}">${:startUrl}</a> }] return } } file delete -force [ns_server pagedir]/.well-known # # Get certificate # set status [:certificateRequest] if {$status >= 400} { :abortMsg $status "Certificate request" return } # # Install certificate and update configuration # :certificateInstall :updateConfiguration ns_write [subst {<br> To use the new certificate, restart your NaviServer instance and check results on <a href="https://${:domain}">https://${:domain}</a>. <p> }] } } } # Check user access if configured if { ($enabled == 0 && [ns_conn peeraddr] ni {"127.0.0.1" "::1"}) || ($user ne "" && ([ns_conn authuser] ne $user || [ns_conn authpassword] ne $password)) } { ns_returnunauthorized return } # Produce page ns_set update [ns_conn outputheaders] "Expires" "now" set c [::letsencrypt::Client new] $c getCertificate $c destroy # # Local variables: # mode: tcl # tcl-indent-level: 4 # indent-tabs-mode: nil # End:
