XUSSPKI ;ISF/RWF - Kernel Security Services PKI ;02/04/2003 13:19
;;8.0;KERNEL;**283**;Jul 10, 1995
;;
Q ;No entry from top
;Supported by IA # 3539
;This is a M api to store the Digital Signature in file 8980.2
STORESIG(XU1,XU2,XU3,XU4,XU5) ;Store the signature.
;XU1 is the hash
;XU2 is the string length
;XU3 is an array for the sig
;XU4 is the DUZ of the signer
;XU5 is the file that holds the data.
;Returns 1 if filed OK, "-1^message" if an error.
N FDA,IEN,CNT,ROOT
I $$FIND1^DIC(8980.2,,"X",XU1)>0 Q "-1^Dup Hash"
I $G(XU4)<.5 Q "-1^No DUZ"
I $G(XU5)="" Q "-1^No File Number"
S CNT=0,ROOT="XU3"
F S ROOT=$Q(@ROOT) Q:ROOT="" S CNT=CNT+$L(@ROOT)
I CNT'=XU2 Q "-1^BAD SIG LENGTH"
S FDA(8980.2,"+1,",.01)=XU1
S FDA(8980.2,"+1,",.02)=XU2
S FDA(8980.2,"+1,",.03)=XU4
S FDA(8980.2,"+1,",.04)=XU5
S FDA(8980.2,"+1,",1)="XU3"
D UPDATE^DIE("S","FDA","IEN")
I $D(^TMP("DIERR",$J)) Q "-1^DBS Error"
Q 1
;
;Supported by IA # 3539
CRLURL(XU1) ;Store the URL for the CRL
;Store each URL as a separte record
N FDA,IEN,CNT,NOW,X,Y,ERR
S ERR=0,NOW=$$NOW^XLFDT
F CNT=1:1 S X=$P(XU1,$C(9),CNT) Q:X="" D
. S Y=$$LOW^XLFSTR($E(X,1,4))
. I '((Y="http")!(Y="ldap")) Q
. S FDA(8980.22,"?+"_CNT_",",.01)=X
. S FDA(8980.22,"?+"_CNT_",",1)=NOW
. D UPDATE^DIE("S","FDA","IEN")
. I $D(^TMP("DIERR",$J)) S ERR=1
. Q
Q $S('ERR:1,1:"-1^DBS Error")
;
;Supported by IA # 3539
VERIFY(XU1,XU2,XU3) ;Veryify the data
;The HASH is in XU1
;The data root is in XU2
;(optional) Date to check against
N CNT,IEN,SD,DR,R,V,ZX K ^TMP("PKI",$J),^TMP("pki",$J)
S IEN=$$FIND1^DIC(8980.2,,"X",XU1)
I IEN'>0 Q "-1^FAIL TO FIND HASH"
S CNT=0,SD=$NA(^TMP("PKI",$J)),DR=$E(XU2,1,$L(XU2)-1)
;Load the data into the buffer
F S XU2=$Q(@XU2) Q:XU2'[DR S V=@XU2 I $L(V) D ADD(V)
D ADD("") ;Blank line between
;Load the Digital Signature into the buffer
F I=1:1 Q:'$D(^XUSSPKI(8980.2,IEN,1,I,0)) S V=^(0) I $L(V) D ADD(V)
;Then a Blank line and the Date.
D ADD(""),ADD($G(XU3))
;Send the buffer
S S=$$EN^XUSC1("DSIG",SD,$NA(ZX))
S R=$S(S<0:S,1:ZX(1))
Q R
ADD(V) ;Add to the send array
S CNT=CNT+1,@SD@(CNT)=V
Q
;
CRLUP ;Send any unsent CRL URL's to the server
;Server port is 10270
L ^XUSSPKI(8980.22,"AC"):1 I '$T Q ;Busy
N CNT,SD,FDA,IEN,LIM,NOW,X1,X2,X3 K ^TMP("PKI",$J),^TMP("XUSSPKI",$J)
;Only send for 300 days past last seen date
S X1=0,LIM=$$HTFM^XLFDT($H-300),CNT=0,NOW=$$NOW^XLFDT
S SD=$NA(^TMP("PKI",$J)),FDA=$NA(^TMP("XUSSPKI",$J))
F S X1=$O(^XUSSPKI(8980.22,X1)) Q:X1="" D
. S X2=$G(^XUSSPKI(8980.22,X1,0)),X2(1)=$P(X2,U,1),X2(2)=$P(X2,U,2),X2(3)=$P(X2,U,3) Q:'$L(X2(1))
. ;Only send http for now
. I "http:"'=$$LOW^XLFSTR($E(X2,1,5)) Q
. ;Check last seen, Last sent more than 3 hours ago.
. I (X2(2)<LIM)!($$FMDIFF^XLFDT(NOW,X2(3),2)<10800) Q
. D ADD(X2(1)) S @FDA@("8980.22",X1_",",2)=NOW
. Q
S S=-1 ;Init var, CNT update in ADD
;Send the buffer of CRL URL's
I CNT D
. S S=$$EN^XUSC1("CRL ",SD,$NA(X3))
. S @SD@("Result")=S_"^"_$G(X3(1))
. S S=$S(S<0:S,$G(X3(1))'="OK":"-3^"_$G(X3(1)),1:S)
I CNT,(S<0) D
. N XMB,XMY,XMTEXT,XMDUZ S XMB(1)=S,XMB(2)=$$FMTE^XLFDT(NOW),XMDUZ="CRL Upload Task"
. S XMB="XUSSPKI CRL SERVER" D ^XMB
. Q
I S'<0 D
. D FILE^DIE("K",FDA)
Q
TESTCRL ;TEST CRLUP
N FDA,LUD
S DA=0,RT=$NA(^XUSSPKI(8980.22)),LUD=$$HTFM^XLFDT(+$H_",120")
F S DA=$O(@RT@(DA)) Q:DA'>0 S FDA(8980.22,DA_",",2)=LUD
D FILE^DIE("K","FDA")
D CRLUP
W "Result: ",$G(^TMP("PKI",$J,"Result"))
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXUSSPKI 3559 printed Sep 23, 2025@19:49:13 Page 2
XUSSPKI ;ISF/RWF - Kernel Security Services PKI ;02/04/2003 13:19
+1 ;;8.0;KERNEL;**283**;Jul 10, 1995
+2 ;;
+3 ;No entry from top
QUIT
+4 ;Supported by IA # 3539
+5 ;This is a M api to store the Digital Signature in file 8980.2
STORESIG(XU1,XU2,XU3,XU4,XU5) ;Store the signature.
+1 ;XU1 is the hash
+2 ;XU2 is the string length
+3 ;XU3 is an array for the sig
+4 ;XU4 is the DUZ of the signer
+5 ;XU5 is the file that holds the data.
+6 ;Returns 1 if filed OK, "-1^message" if an error.
+7 NEW FDA,IEN,CNT,ROOT
+8 IF $$FIND1^DIC(8980.2,,"X",XU1)>0
QUIT "-1^Dup Hash"
+9 IF $GET(XU4)<.5
QUIT "-1^No DUZ"
+10 IF $GET(XU5)=""
QUIT "-1^No File Number"
+11 SET CNT=0
SET ROOT="XU3"
+12 FOR
SET ROOT=$QUERY(@ROOT)
if ROOT=""
QUIT
SET CNT=CNT+$LENGTH(@ROOT)
+13 IF CNT'=XU2
QUIT "-1^BAD SIG LENGTH"
+14 SET FDA(8980.2,"+1,",.01)=XU1
+15 SET FDA(8980.2,"+1,",.02)=XU2
+16 SET FDA(8980.2,"+1,",.03)=XU4
+17 SET FDA(8980.2,"+1,",.04)=XU5
+18 SET FDA(8980.2,"+1,",1)="XU3"
+19 DO UPDATE^DIE("S","FDA","IEN")
+20 IF $DATA(^TMP("DIERR",$JOB))
QUIT "-1^DBS Error"
+21 QUIT 1
+22 ;
+23 ;Supported by IA # 3539
CRLURL(XU1) ;Store the URL for the CRL
+1 ;Store each URL as a separte record
+2 NEW FDA,IEN,CNT,NOW,X,Y,ERR
+3 SET ERR=0
SET NOW=$$NOW^XLFDT
+4 FOR CNT=1:1
SET X=$PIECE(XU1,$CHAR(9),CNT)
if X=""
QUIT
Begin DoDot:1
+5 SET Y=$$LOW^XLFSTR($EXTRACT(X,1,4))
+6 IF '((Y="http")!(Y="ldap"))
QUIT
+7 SET FDA(8980.22,"?+"_CNT_",",.01)=X
+8 SET FDA(8980.22,"?+"_CNT_",",1)=NOW
+9 DO UPDATE^DIE("S","FDA","IEN")
+10 IF $DATA(^TMP("DIERR",$JOB))
SET ERR=1
+11 QUIT
End DoDot:1
+12 QUIT $SELECT('ERR:1,1:"-1^DBS Error")
+13 ;
+14 ;Supported by IA # 3539
VERIFY(XU1,XU2,XU3) ;Veryify the data
+1 ;The HASH is in XU1
+2 ;The data root is in XU2
+3 ;(optional) Date to check against
+4 NEW CNT,IEN,SD,DR,R,V,ZX
KILL ^TMP("PKI",$JOB),^TMP("pki",$JOB)
+5 SET IEN=$$FIND1^DIC(8980.2,,"X",XU1)
+6 IF IEN'>0
QUIT "-1^FAIL TO FIND HASH"
+7 SET CNT=0
SET SD=$NAME(^TMP("PKI",$JOB))
SET DR=$EXTRACT(XU2,1,$LENGTH(XU2)-1)
+8 ;Load the data into the buffer
+9 FOR
SET XU2=$QUERY(@XU2)
if XU2'[DR
QUIT
SET V=@XU2
IF $LENGTH(V)
DO ADD(V)
+10 ;Blank line between
DO ADD("")
+11 ;Load the Digital Signature into the buffer
+12 FOR I=1:1
if '$DATA(^XUSSPKI(8980.2,IEN,1,I,0))
QUIT
SET V=^(0)
IF $LENGTH(V)
DO ADD(V)
+13 ;Then a Blank line and the Date.
+14 DO ADD("")
DO ADD($GET(XU3))
+15 ;Send the buffer
+16 SET S=$$EN^XUSC1("DSIG",SD,$NAME(ZX))
+17 SET R=$SELECT(S<0:S,1:ZX(1))
+18 QUIT R
ADD(V) ;Add to the send array
+1 SET CNT=CNT+1
SET @SD@(CNT)=V
+2 QUIT
+3 ;
CRLUP ;Send any unsent CRL URL's to the server
+1 ;Server port is 10270
+2 ;Busy
LOCK ^XUSSPKI(8980.22,"AC"):1
IF '$TEST
QUIT
+3 NEW CNT,SD,FDA,IEN,LIM,NOW,X1,X2,X3
KILL ^TMP("PKI",$JOB),^TMP("XUSSPKI",$JOB)
+4 ;Only send for 300 days past last seen date
+5 SET X1=0
SET LIM=$$HTFM^XLFDT($HOROLOG-300)
SET CNT=0
SET NOW=$$NOW^XLFDT
+6 SET SD=$NAME(^TMP("PKI",$JOB))
SET FDA=$NAME(^TMP("XUSSPKI",$JOB))
+7 FOR
SET X1=$ORDER(^XUSSPKI(8980.22,X1))
if X1=""
QUIT
Begin DoDot:1
+8 SET X2=$GET(^XUSSPKI(8980.22,X1,0))
SET X2(1)=$PIECE(X2,U,1)
SET X2(2)=$PIECE(X2,U,2)
SET X2(3)=$PIECE(X2,U,3)
if '$LENGTH(X2(1))
QUIT
+9 ;Only send http for now
+10 IF "http:"'=$$LOW^XLFSTR($EXTRACT(X2,1,5))
QUIT
+11 ;Check last seen, Last sent more than 3 hours ago.
+12 IF (X2(2)<LIM)!($$FMDIFF^XLFDT(NOW,X2(3),2)<10800)
QUIT
+13 DO ADD(X2(1))
SET @FDA@("8980.22",X1_",",2)=NOW
+14 QUIT
End DoDot:1
+15 ;Init var, CNT update in ADD
SET S=-1
+16 ;Send the buffer of CRL URL's
+17 IF CNT
Begin DoDot:1
+18 SET S=$$EN^XUSC1("CRL ",SD,$NAME(X3))
+19 SET @SD@("Result")=S_"^"_$GET(X3(1))
+20 SET S=$SELECT(S<0:S,$GET(X3(1))'="OK":"-3^"_$GET(X3(1)),1:S)
End DoDot:1
+21 IF CNT
IF (S<0)
Begin DoDot:1
+22 NEW XMB,XMY,XMTEXT,XMDUZ
SET XMB(1)=S
SET XMB(2)=$$FMTE^XLFDT(NOW)
SET XMDUZ="CRL Upload Task"
+23 SET XMB="XUSSPKI CRL SERVER"
DO ^XMB
+24 QUIT
End DoDot:1
+25 IF S'<0
Begin DoDot:1
+26 DO FILE^DIE("K",FDA)
End DoDot:1
+27 QUIT
TESTCRL ;TEST CRLUP
+1 NEW FDA,LUD
+2 SET DA=0
SET RT=$NAME(^XUSSPKI(8980.22))
SET LUD=$$HTFM^XLFDT(+$HOROLOG_",120")
+3 FOR
SET DA=$ORDER(@RT@(DA))
if DA'>0
QUIT
SET FDA(8980.22,DA_",",2)=LUD
+4 DO FILE^DIE("K","FDA")
+5 DO CRLUP
+6 WRITE "Result: ",$GET(^TMP("PKI",$JOB,"Result"))
+7 QUIT
