Demo entry 6633599

Simpleca.tcl

   

Submitted by anonymous on Aug 04, 2017 at 03:34
Language: Tcl. Code size: 2.9 kB.

proc cmd::RevokeCert {} {
    
    debug::msg "cmd::RevokeCert"
    
    # now in openssl::
    #variable cmd    
    #global config_file
    
    # request attributes
    
	
    set csr_fn [tk_getOpenFile -defaultextension .crt \
      -filetypes {
	{{Certificates} {.crt}}
	{{All Files} *}
       } \
      -initialdir certificates \
      -title "Select certificate to revoke"]
    
    if {$csr_fn != "" } {

	set attributes [openssl::CRT_GetSubject $csr_fn]
	set attr(exit) [Dialog_ConfirmAttributes .popup {Do you want to revoke this certificate ?} $attributes]
    }
    
    if {$csr_fn != "" && $attr(exit) == "ok"} {
	array set attr [Dialog_AskAttributes .popup {Revoke Certificate} {
	    *password {CA Key Password}  {}  "!" }]
    }
    
    if {$csr_fn != "" && $attr(exit) == "ok"} {
	
	# key filename = csr filename, but in stead .key extension.
	regsub {\.crt$} $csr_fn {} attr(fn)
	
	update
	
	# revoke cert
	openssl::do srv_revoke signserver attr
	
	#set f [open "config.cfg" w]
	#puts $f [subst -nocommands -nobackslashes $config_file(signserver)]
	#close $f
	##after 1000
	##catch {eval exec [subst $cmd(srv_revoke)]}
	#global env    
	#set env(password) $attr(*password)
	#openssl [subst $cmd(srv_revoke)]
	#catch {file delete "config.cfg"}
	#if {[file exists "ca.db.index.new"]} {
	#    file rename -force "ca.db.index.new" "ca.db.index"
	#}

	# reload certificate info
	GetCertificates .main ca.db.index

    } 

}

proc cmd::RevokeCertByIndex {certs} {
    
    debug::msg "cmd::RevokeCertByIndex $certs"
    

    #now in openssl::
    #variable cmd
    #global config_file
    #set f [open "config.cfg" w]
    #puts $f [subst -nocommands -nobackslashes $config_file(signserver)]
    #close $f

    # request attributes
    
    foreach cert $certs {
	
	set crt_fn "ca.db.certs/$cert.pem"

	set attributes [openssl::CRT_GetSubject $crt_fn]
	set attr(exit) [Dialog_ConfirmAttributes .popup {Do you want to revoke this certificate ?} $attributes]
    
	if {$attr(exit) != "ok"} {
	    break
	}
	
	array set attr [Dialog_AskAttributes .popup {Revoke Certificate} {
	    *password {CA Key Password} {}  "!" }]

	if {$attr(exit) != "ok"} {
	    break
	}
		
	# key filename = csr filename, but in stead .key extension.
	regsub {\.crt$} $crt_fn {} attr(fn)
	
	# revoke cert
	openssl::do cert_revoke signserver attr
	
	#now in openssl::
	#global env    
	#set env(password) $attr(*password)
	##catch {eval exec [subst $cmd(cert_revoke)]}
	#openssl [subst $cmd(cert_revoke)]
	#if {[file exists "ca.db.index.new"]} {
	#    file rename -force "ca.db.index.new" "ca.db.index"
	#}


    } 

    #now in openssl::
    #catch {file delete "config.cfg"}

    # reload certificate info
    GetCertificates .main ca.db.index

}

This snippet took 0.01 seconds to highlight.

Back to the Entry List or Home.

Delete this entry (admin only).