Client Certificate Details

$!-----------------------------------------------------------------'f$verify(0) $! CLIENT_CERT_DETAILS.COM $! $! WASD VMS Web Services, Copyright (c) 1996-2001 Mark G.Daniel. $! This package (all associated programs), comes with ABSOLUTELY NO WARRANTY. $! This is free software, and you are welcome to redistribute it $! under the conditions of the GNU GENERAL PUBLIC LICENSE, version 2. $! $! Operates in one of two alternate modes: $! $! 1) Displays the detail of a client X509 certificate. $! 2) Emails (via VMS CLI Mail) those details to a specified address. $! $! Requires the following entry (or similarly effective) in HTTPD$AUTH $! $! ["X509 Client Certs"=X509] $! /cgi-bin/client_cert_details r+w,param="[vf:OPTIONAL][to:EXPIRED]" $! $! Requires the following entry (or similarly effective) in HTTPD$MAP $! $! set /cgi-bin/client_cert_details SSLCGI=apache_mod_ssl $! $! This script may be easily cloned - just copy it to a new procedure name! $! To enable the email functionality define a system-wide logical containing $! the address using $EMAIL. For instance, a logical for this $! original procedure could be defined using $! $! $ DEFINE /SYSTEM CLIENT_CERT_DETAILS$EMAIL "mark.daniel@wasd.vsm.com.au" $! $! To enable problem resolution use a similar mechanism $DEBUG $! $! $ DEFINE /SYSTEM CLIENT_CERT_DETAILS$DEBUG 1 $! $! 18-DEC-2000 MGD initial $!----------------------------------------------------------------------------- $! $ if f$type(scratchDir) .eqs. "" $ then $ if f$trnlnm("HT_SCRATCH") .eqs. "" $ then scratchDir = "HT_SCRATCH:" $ else scratchDir = "SYS$SCRATCH:" $ endif $ endif $ procName = f$parse(f$environment("procedure"),,,"name") $ debug = procName + "$DEBUG" $ debug = f$trnlnm(debug) $ if debug $ then $ type sys$input Content-Type: text/plain $ set verify $ endif $ say = "write sys$output" $! $!----------------------------------------------------------------------------- $! $!(massage P1 symbol containing P2 character sequences into P3) $ massageLine: subroutine $ outString = "" $ inString = 'P1' $ massageStringLoop: $ inStringLen = f$length(inString) $ inStringPos = f$locate("''P2'",inString) $ if inStringPos .ge. inStringLen then goto massageStringLoopEnd $ outString = outString + f$extract(0,inStringPos,inString) + "''P3'" $ inString = f$extract(inStringPos+1,999,inString) $ goto massageStringLoop $ massageStringLoopEnd: $ outString = outString + f$extract(0,999,inString) $!(global symbol output) $ 'P1' == outString $ exit $ endsubroutine $! $!----------------------------------------------------------------------------- $! $!(output the symbol specified in P1, massaging reserved sequences first) $ saySymbol: subroutine $ nl[0,8] = 10 $ delsymglob = "delete/symbol/global" $!(must be a global symbol) $ inString == 'P1' $!(massage various character sequences - ordering of calls is important!) $ call massageLine inString "&" "&" $ call massageLine inString "<" "<" $ call massageLine inString ">" ">" $ call massageLine inString "''nl'" "
" $ write/symbol sys$output inString $ delsymglob inString $ exit $ endsubroutine $! $!----------------------------------------------------------------------------- $! $ type sys$input Content-Type: text/html Script-Control: X-buffer-records Client Certificate Details

Client Certificate Details

$! $!(check that we've got all the essentials) $ ok = 1 $ if f$type(WWW_AUTH_USER) .eqs. "" then ok = 0 $ if f$type(WWW_AUTH_X509_FINGERPRINT) .eqs. "" then ok = 0 $ if f$type(WWW_QUERY_STRING) .eqs. "" then ok = 0 $ if f$type(WWW_REMOTE_USER) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_VERSION_LIBRARY) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_I_DN_O) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_I_DN_OU) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_I_DN_CN) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_S_DN_O) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_S_DN_OU) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_S_DN_CN) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_V_START) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_V_END) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_A_KEY) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CLIENT_A_SIG) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CIPHER_ALGKEYSIZE) .eqs. "" then ok = 0 $ if f$type(WWW_SSL_CIPHER_USEKEYSIZE) .eqs. "" then ok = 0 $ if .not. ok $ then $ type sys$input

The required SSL information is not available (check the setup requirements). $ exit $ endif $! $ emailLogical = procName + "$EMAIL" $ emailTo = f$trnlnm(emailLogical) $! $ if f$edit(WWW_QUERY_STRING,"lowercase") .eqs. "details=send" $ then $ call sendDetails "''emailTo'" $ exit $ endif $! $ type sys$input

$! $ say " $ say " $ say " $ if f$type(WWW_SSL_CLIENT_I_DN_EMAIL) .nes. "" $ then $ say " $ endif $! $ say "" $ say "" $! $ say " $ say " $ say " $ if f$type(WWW_SSL_CLIENT_S_DN_EMAIL) .nes. "" $ then $ say " $ endif $! $ say "" $ say "" $! $ say " $ say " $ say " $ say " $! $ say "

Issuer (CA)
Organization: " $ call saySymbol WWW_SSL_CLIENT_I_DN_O $ say "
Organizational Unit: " $ call saySymbol WWW_SSL_CLIENT_I_DN_OU $ say "
Common Name: " $ call saySymbol WWW_SSL_CLIENT_I_DN_CN $ say "
Email: " $ call saySymbol WWW_SSL_CLIENT_I_DN_EMAIL $ say "

Subject (Client)
Organization: " $ call saySymbol WWW_SSL_CLIENT_S_DN_O $ say "
Organizational Unit: " $ call saySymbol WWW_SSL_CLIENT_S_DN_OU $ say "
Common Name: " $ call saySymbol WWW_SSL_CLIENT_S_DN_CN $ say "
Email: " $ call saySymbol WWW_SSL_CLIENT_S_DN_EMAIL $ say "

Other
Start: " +- WWW_SSL_CLIENT_V_START + "
End: " +- WWW_SSL_CLIENT_V_END + "
Fingerprint: " +- WWW_AUTH_X509_FINGERPRINT + " " + WWW_SSL_CLIENT_A_SIG +- "
Session Cipher: " +- WWW_SSL_CIPHER + " key: " + WWW_SSL_CIPHER_USEKEYSIZE +- " / " + WWW_SSL_CIPHER_ALGKEYSIZE + " " + WWW_SSL_CLIENT_A_KEY +- "
" $! $ if emailTo .nes. "" $ then $ type sys$input

	Issuer (CA)
Organization:	" $ call saySymbol WWW_SSL_CLIENT_I_DN_O $ say "
Organizational Unit:	" $ call saySymbol WWW_SSL_CLIENT_I_DN_OU $ say "
Common Name:	" $ call saySymbol WWW_SSL_CLIENT_I_DN_CN $ say "
Email:	" $ call saySymbol WWW_SSL_CLIENT_I_DN_EMAIL $ say "

	Subject (Client)
Organization:	" $ call saySymbol WWW_SSL_CLIENT_S_DN_O $ say "
Organizational Unit:	" $ call saySymbol WWW_SSL_CLIENT_S_DN_OU $ say "
Common Name:	" $ call saySymbol WWW_SSL_CLIENT_S_DN_CN $ say "
Email:	" $ call saySymbol WWW_SSL_CLIENT_S_DN_EMAIL $ say "

	Other
Start:	" +- WWW_SSL_CLIENT_V_START + "
End:	" +- WWW_SSL_CLIENT_V_END + "
Fingerprint:	" +- WWW_AUTH_X509_FINGERPRINT + " " + WWW_SSL_CLIENT_A_SIG +- "
Session Cipher:	" +- WWW_SSL_CIPHER + " key: " + WWW_SSL_CIPHER_USEKEYSIZE +- " / " + WWW_SSL_CIPHER_ALGKEYSIZE + " " + WWW_SSL_CLIENT_A_KEY +- "

Check this is the certificate you wish to use. If not just reload the page and specify another. To provide these details to the site administrator click on the button below. The browser will request the certificate again. Just specify the same one. These details (none of which compromise the certificate's integrity) will then be sent to this site's administrator for inclusion in the authorization environment. $ say "

$ if f$type(WWW_SERVER_SIGNATURE) .nes. "" then say "

" + WWW_SERVER_SIGNATURE $ endif $! $ type sys$input $ exit $! $!----------------------------------------------------------------------------- $! $ sendDetails: subroutine $ set noon $ sysOutput = f$trnlnm("SYS$OUTPUT") $ sysError = f$trnlnm("SYS$ERROR") $ if .not. debug then define sys$output nl: $ if .not. debug then define sys$error nl: $ scratchFileName = procName - "_" - "_" - "_" - "_" - "_" - "_" $ scratchFileName = scratchDir + procName + "." + f$cvtime(,,"year") +- f$cvtime(,,"month") + f$cvtime(,,"day") + f$cvtime(,,"hour") +- f$cvtime(,,"minute") + f$cvtime(,,"second") + f$cvtime(,,"hundredth") $ create 'scratchFileName' /fdl=SYS$INPUT: FILE ORGANIZATION sequential RECORD CARRIAGE_CONTROL carriage_return FORMAT stream_LF $ open/append scratchFile 'scratchFileName' $ write scratchFile "Client Certificate Details" $ write scratchFile "--------------------------" $ write scratchFile "" $ write scratchFile "At: " + f$time() $ write scratchFile "By: " +- f$element(0,";",f$environment("procedure")) $ write scratchFile "From: " + WWW_AUTH_USER $ write scratchFile "User: " + WWW_REMOTE_USER + " (fingerprint)" $ write scratchFile "" $ write scratchFile "ISSUER" $ write scratchFile "------" $ WWW_SSL_CLIENT_I_DN_O = "* organization=" + WWW_SSL_CLIENT_I_DN_O $ write/symbol scratchFile WWW_SSL_CLIENT_I_DN_O $ WWW_SSL_CLIENT_I_DN_OU = "* organizationalUnit=" + WWW_SSL_CLIENT_I_DN_OU $ write/symbol scratchFile WWW_SSL_CLIENT_I_DN_OU $ WWW_SSL_CLIENT_I_DN_CN = "* commonName=" + WWW_SSL_CLIENT_I_DN_CN $ write/symbol scratchFile WWW_SSL_CLIENT_I_DN_CN $ if f$type(WWW_SSL_CLIENT_I_DN_EMAIL) .nes. "" $ then $ WWW_SSL_CLIENT_I_DN_EMAIL = "* email=" + WWW_SSL_CLIENT_I_DN_EMAIL $ write/symbol scratchFile WWW_SSL_CLIENT_I_DN_EMAIL $ endif $ write scratchFile "" $ write scratchFile "SUBJECT" $ write scratchFile "-------" $ WWW_SSL_CLIENT_S_DN_O = "* organization=" + WWW_SSL_CLIENT_S_DN_O $ write/symbol scratchFile WWW_SSL_CLIENT_S_DN_O $ WWW_SSL_CLIENT_S_DN_OU = "* organizationalUnit=" + WWW_SSL_CLIENT_S_DN_OU $ write/symbol scratchFile WWW_SSL_CLIENT_S_DN_OU $ WWW_SSL_CLIENT_S_DN_CN = "* commonName=" + WWW_SSL_CLIENT_S_DN_CN $ write/symbol scratchFile WWW_SSL_CLIENT_S_DN_CN $ if f$type(WWW_SSL_CLIENT_S_DN_EMAIL) .nes. "" $ then $ WWW_SSL_CLIENT_S_DN_EMAIL = "* email=" + WWW_SSL_CLIENT_S_DN_EMAIL $ write/symbol scratchFile WWW_SSL_CLIENT_S_DN_EMAIL $ endif $ write scratchFile "" $ write scratchFile "OTHER" $ write scratchFile "-----" $ WWW_SSL_CLIENT_V_START = "* start=" + WWW_SSL_CLIENT_V_START $ write/symbol scratchFile WWW_SSL_CLIENT_V_START $ WWW_SSL_CLIENT_V_END = "* end=" + WWW_SSL_CLIENT_V_END $ write/symbol scratchFile WWW_SSL_CLIENT_V_END $ write scratchFile "* fingerprint=" + WWW_AUTH_X509_FINGERPRINT $ write scratchFile "* session=" + WWW_SSL_CIPHER + " key: " +- WWW_SSL_CIPHER_USEKEYSIZE + "/" + WWW_SSL_CIPHER_ALGKEYSIZE $ close scratchFile $ subjectAuthUser = f$extract(0,99,WWW_AUTH_USER) $ mail 'scratchFileName' "''P1'" - /subject="X509 fingerprint from ''subjectAuthUser'" $ mailStatus = $STATUS $ delete /nolog /noconfirm 'scratchFileName';* $ define /nolog sys$output 'sysOutput' $ define /nolog sys$error 'sysError' $ if mailStatus $ then $ say "

Details were sent successfully! Thankyou." $ else $ say "

An error occured during sending." $ say "
Please contact the site administrator." $ endif $ if f$type(WWW_SERVER_SIGNATURE) .nes. "" $ then $ say "

" $ say WWW_SERVER_SIGNATURE $ endif $ exit $ endsubroutine $! $!-----------------------------------------------------------------------------