XUSSPKI.m

XUSSPKI ;ISF/RWF - Kernel Security Services PKI ;02/04/2003  13:19 [ 07/29/2004   9:01 AM ]

 ;;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

XUSSPKI   ;ISF/RWF - Kernel Security Services PKI ;02/04/2003  13:19 [ 07/29/2004   9:01 AM ]

 +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