Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: PSOSPMKY

PSOSPMKY.m

Go to the documentation of this file. 
  1. PSOSPMKY ;BIRM/MFR - State Prescription Monitoring Program - SSH Key Management ;01/06/16
  1.  ;;7.0;OUTPATIENT PHARMACY;**451,625,723**;DEC 1997;Build 13
  1.  ;
  1. EN ; Entry-point
  1.  N STATEIEN,DIC,X,Y,DUOUT,DTOUT,PSOOS,LOCALDIR,X1,DIR,DIRUT,LOCALDIR
  1.  W ! K DIC S DIC("A")="Select STATE: ",DIC="^PS(58.41,",DIC(0)="QOEAM"
  1.  I $O(^PS(58.41,0)) S DIC("B")=$O(^PS(58.41,0))
  1.  D ^DIC I X=""!(X="^")!$D(DUOUT)!$D(DTOUT) G END
  1.  K DIC("A") G:Y<0 EN S STATEIEN=+Y
  1.  ;
  1. ACTION ; SSH Key Action
  1.  K DIR S DIR("A")="Action"
  1.  S DIR(0)="S^V:View Public SSH Key;N:Create New SSH Key Pair;"
  1.  S DIR(0)=DIR(0)_"D:Delete SSH Key Pair;H:Help with SSH Keys"
  1.  S DIR("B")="V" D ^DIR I $D(DUOUT)!($D(DIRUT)) G END
  1.  I Y="N"!(Y="D"),'$D(^XUSEC("PSO SPMP ADMIN",DUZ)) D  G ACTION
  1.  . W !!,"The PSO SPMP ADMIN security key is required for this action.",$C(7)
  1.  K ^TMP("PSOPUBKY",$J) D RETRIEVE(STATEIEN,"PUB")
  1.  I Y="V"!(Y="D"),'$D(^TMP("PSOPUBKY",$J)) D  G ACTION
  1.  . W !!,"[No SSH Key Pair found for ",$$GET1^DIQ(5,STATEIEN,.01),"]",$C(7) D PAUSE^PSOSPMU1
  1.  I Y="N"!(Y="D") D SIG^XUSESIG I X="^"!($G(X1)="") W:$G(X1)="" " SIGNATURE NOT VERIFIED",$C(7) G ACTION
  1.  ; 
  1.  ; View Public SSH Key
  1.  I Y="V" D  G ACTION
  1.  . W ! D VIEW(STATEIEN),PAUSE^PSOSPMU1
  1.  ;
  1.  ; Create New SSH Key Pair
  1.  I Y="N" D  G ACTION
  1.  . S PSOOS=$$BKENDOS()
  1.  . S LOCALDIR=$$GET1^DIQ(58.41,STATEIEN,$S(PSOOS["VMS":4,1:15))
  1.  . I LOCALDIR="" D  Q
  1.  . . W !!,"The ",$S(PSOOS["VMS":"OPEN VMS",1:"UNIX/LINUX")," LOCAL DIRECTORY parameter is missing for ",$$GET1^DIQ(5,STATEIEN,.01),". Please,"
  1.  . . W !,"update it in the View/Edit SPMP State Parameters option and try again.",$C(7) D PAUSE^PSOSPMU1
  1.  . K DIR S DIR("A")="SSH Key Encryption Type",DIR("?")="^D ETHELP^PSOSPMKY"
  1.  . S DIR(0)="S^RSA:Rivest, Shamir & Adleman (RSA);DSA:Digital Signature Algorithm (DSA);ECDSA:Elliptic Curve Digital Signature Algorithm (ECDSA);EDDSA:Edward-curve Digital Signature Algorithm (ed25519)" ;p723
  1.  . S DIR("B")="RSA" D ^DIR I $D(DUOUT)!($D(DIRUT)) Q
  1.  . S ENCRTYPE=Y I Y="DSA" D  Q
  1.  . . W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," 'DSA' SSH keys are being phased out and are no longer supported.",$C(7)
  1.  . ;p723 prompt for bit size for ECDSA
  1.  . I ENCRTYPE="ECDSA" D  I $D(DUOUT)!($D(DIRUT)) Q
  1.  . . K DIR S DIR("A")="ECDSA encryption key size (bit size)",DIR("?")="Available key sizes are 256 bits, 384 bits, or 521 bits.  Also referred to as key length."
  1.  . . S DIR(0)="S^256:256 bits;384:384 bits;521:521 bits"
  1.  . . S DIR("B")="256" D ^DIR
  1.  . S ENCRBITS=$S(ENCRTYPE="ECDSA":Y,1:"")
  1.  . I $D(^TMP("PSOPUBKY",$J)) D
  1.  . . W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," You may be overwriting SSH Keys that are currently in use.",$C(7)
  1.  . K DIR S DIR("A")="Confirm Creation of SSH "_ENCRTYPE_" Keys for "_$$GET1^DIQ(5,STATEIEN,.01),DIR(0)="Y",DIR("B")="NO"
  1.  . W ! D ^DIR I $D(DIRUT)!$D(DUOUT)!'Y Q
  1.  . ; Deleting Existing SSH Key
  1.  . I $D(^TMP("PSOPUBKY",$J)) D DELETE(STATEIEN)
  1.  . W !!,"Creating New SSH Keys, please wait..."
  1.  . ;p723 removing the task off logic, unnecessary
  1.  . ;N ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK
  1.  . ;S ZTRTN="NEWKEY^PSOSPMKY("_STATEIEN_","""_ENCRTYPE_""")" 
  1.  . ;S ZTDESC="State Prescription Monitoring Program (SPMP) SSH Key Generation"
  1.  . ;S ZTDTH=$$NOW^XLFDT() D ^%ZTLOAD K ZTSK
  1.  . ;K ^TMP("PSOPUBKY",$J)
  1.  . ;F I=1:1:30 D RETRIEVE(STATEIEN,"PUB") Q:$D(^TMP("PSOPUBKY",$J))  H 1
  1.  . ; If unable to create the key via Taskman after 30 seconds, creates them in the foreground
  1.  . ;I '$D(^TMP("PSOPUBKY",$J)) D
  1.  . D NEWKEY(STATEIEN,ENCRTYPE,ENCRBITS),RETRIEVE(STATEIEN,"PUB") ;p723 pass ENCRBITS
  1.  . I '$D(^TMP("PSOPUBKY",$J)) D
  1.  . . W !!,"There was a problem with the generation of the new SSH Key Pair."
  1.  . . W !,"Please try again and if the problem persists contact IT Support.",$C(7) D PAUSE^PSOSPMU1
  1.  . E  W "Done",$C(7)
  1.  K ENCRBITS
  1.  ;
  1.  ; Delete SSH Key Pair
  1.  I Y="D" D  G ACTION
  1.  . D RETRIEVE(STATEIEN,"PUB")
  1.  . I '$D(^TMP("PSOPUBKY",$J)) D  Q
  1.  . . W !!,"[No SSH Key Pair found for ",$$GET1^DIQ(5,STATEIEN,.01),"]",$C(7)
  1.  . W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," You may be deleting SSH Keys that are currently in use.",$C(7)
  1.  . K DIR S DIR("A")="Confirm Deletion of "_$$GET1^DIQ(5,STATEIEN,.01)_"'s SSH Keys",DIR(0)="Y",DIR("B")="NO"
  1.  . W ! D ^DIR I $D(DIRUT)!$D(DUOUT)!'Y Q
  1.  . W !!,"Deleting SSH Keys..." D DELETE(STATEIEN) H 1 W "Done",$C(7)
  1.  ;
  1.  ; SSH Key Help
  1.  I Y="H" D HELP G ACTION
  1.  ;
  1.  G ACTION
  1.  ;
  1. END Q
  1.  ;
  1. NEWKEY(STATEIEN,ENCRTYPE,ENCRBITS) ; Generate and store a pair of SSH keys for a specific state
  1.  ; Input: (r) STATEIEN - State that will be using the new key pair. Pointer to the STATE file (#5)
  1.  ;        (o) ENCRTYPE - SSH Encryption Type (DSA / RSA) (Default: RSA)
  1.  N LOCALDIR,DATETIME,PSOOS,KEYFILE,PV,FILE2DEL,LINE,OVFLINE,NMSPC,KEYTXT,SAVEKEY,DIE,DR,DA
  1.  ;
  1.  I '$G(STATEIEN) Q  ;Error: State missing
  1.  S PSOOS=$$OS^%ZOSV()
  1.  S LOCALDIR=$$GET1^DIQ(58.41,STATEIEN,$S(PSOOS["VMS":4,1:15)) I LOCALDIR="" Q  ;Error: Missing directory
  1.  ;I $G(ENCRTYPE)'="DSA",$G(ENCRTYPE)'="RSA" S ENCRTYPE="RSA"
  1.  S ENCRTYPE=$S($G(ENCRTYPE)="ECDSA":"ECDSA",$G(ENCRTYPE)="EDDSA":"ed25519",1:"RSA")
  1.  ;
  1.  ; LOCK to avoid OS files overwrite
  1.  F  S DATETIME=$P($$FMTHL7^XLFDT($$HTFM^XLFDT($H)),"-") S KEYFILE="KEY"_DATETIME L +@KEYFILE:0 Q:$T  H 2
  1.  ;
  1.  ; Deleting existing SSH Keys first
  1.  D DELETE(STATEIEN)
  1.  ;
  1.  ; OpenVMS SSH Key Generation
  1.  I PSOOS["VMS" D
  1.  . N COMFILE
  1.  . S COMFILE="COM"_DATETIME_".COM"
  1.  . D OPEN^%ZISH("COMFILE",LOCALDIR,COMFILE,"W")
  1.  . D USE^%ZISUTL("COMFILE")
  1.  . W "SSH_KEYGEN == ""$SYS$SYSTEM:TCPIP$SSH_SSH-KEYGEN2.EXE""",!
  1.  . W "SSH_KEYGEN -t "_$$LOW^XLFSTR($G(ENCRTYPE))_" -""P"" "_LOCALDIR_KEYFILE,!
  1.  . D CLOSE^%ZISH("COMFILE")
  1.  . X "S PV=$ZF(-1,""@"_LOCALDIR_COMFILE_""")"
  1.  . S FILE2DEL(COMFILE)="",FILE2DEL(KEYFILE_".")="",FILE2DEL(KEYFILE_".PUB")=""
  1.  ;
  1.  ; Linux/Unix SSH Key Generation
  1.  I PSOOS["UNIX" D
  1.  . I '$$DIREXIST^PSOSPMU1(LOCALDIR) D MAKEDIR^PSOSPMU1(LOCALDIR)
  1.  . S ENCRBITS=$S($G(ENCRBITS):" -b "_ENCRBITS,1:"")
  1.  . X "S PV=$ZF(-1,""ssh-keygen -q -N '' -C '' -t "_$$LOW^XLFSTR($G(ENCRTYPE))_" -f "_LOCALDIR_KEYFILE_ENCRBITS_""")"
  1.  . S FILE2DEL(KEYFILE)="",FILE2DEL(KEYFILE_".pub")=""
  1.  ;
  1.  K ^TMP("PSOPRVKY",$J),^TMP("PSOPUBKY",$J)
  1.  ; Retrieving SSH Private Key Content
  1.  S X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$S(PSOOS["VMS":".",1:""),$NAME(^TMP("PSOPRVKY",$J,1)),3)
  1.  I '$D(^TMP("PSOPRVKY",$J,1)) Q
  1.  ; Retrieving SSH Public Key Content
  1.  S X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$S(PSOOS["VMS":".PUB",1:".pub"),$NAME(^TMP("PSOPUBKY",$J,1)),3)
  1.  I '$D(^TMP("PSOPUBKY",$J,1)) Q
  1.  ;
  1.  ; Deleting temporary files used to generate the keys
  1.  D DEL^%ZISH(LOCALDIR,"FILE2DEL")
  1.  ;
  1.  ; Saving new SSH Keys content in the SPMP STATE PARAMETERS file (#58.41)
  1.  F NMSPC="PSOPRVKY","PSOPUBKY" D
  1.  . K KEYTXT,SAVEKEY
  1.  . F LINE=1:1 Q:'$D(^TMP(NMSPC,$J,LINE))  D
  1.  . . ; Unix/Linux Public SSH Key has no line-feed (one long line)
  1.  . . I PSOOS["UNIX",NMSPC="PSOPUBKY" D  Q
  1.  . . . S KEYTXT(1)=^TMP(NMSPC,$J,LINE)
  1.  . . . F OVFLINE=1:1 Q:'$D(^TMP(NMSPC,$J,LINE,"OVF",OVFLINE))  D
  1.  . . . . S KEYTXT(1)=$G(KEYTXT(1))_^TMP(NMSPC,$J,LINE,"OVF",OVFLINE)
  1.  . . S KEYTXT(LINE)=$$ENCRYP^XUSRB1(^TMP(NMSPC,$J,LINE))
  1.  . I PSOOS["UNIX",NMSPC="PSOPUBKY" S KEYTXT(1)=$$ENCRYP^XUSRB1(KEYTXT(1))
  1.  . S SAVEKEY(58.41,STATEIEN_",",$S(NMSPC="PSOPRVKY":100,1:200))="KEYTXT"
  1.  . D UPDATE^DIE("","SAVEKEY")
  1.  . K ^TMP(NMSPC,$J)
  1.  ;
  1.  ; Saving SSH Key Format (SSH2/OpenSSH) and Encryption Type (DSA/RSA) fields
  1.  K DIE S DIE="^PS(58.41,",DA=STATEIEN
  1.  S DR="18///"_$S(PSOOS["VMS":"SSH2",1:"OSSH")_";19////"_ENCRTYPE D ^DIE
  1.  ;
  1.  L -@KEYFILE
  1.  Q
  1.  ;
  1. RETRIEVE(STATEIEN,KEYTYPE) ; Retrieve the SSH Key into the ^TMP global
  1.  ; Input: (r) STATEIEN - State to retrieve the SSH Key from
  1.  ;        (o) KEYTYPE  - SSH Key Type (PUB - Public / PRV - PRivate) (Default: Public)
  1.  ;Output: ^TMP("PSO[PUB/PRV]KY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
  1.  ;        ^TMP("PSO[PUB/PRV]KY",$J,1-N)=[SSH Key Content]
  1.  N X,LINE,KEYTXT,NMSPC
  1.  I $G(KEYTYPE)'="PUB",$G(KEYTYPE)'="PRV" S KEYTYPE="PUB"
  1.  S X=$$GET1^DIQ(58.41,STATEIEN_",",$S(KEYTYPE="PRV":100,1:200),,"KEYTXT")
  1.  S NMSPC=$S(KEYTYPE="PRV":"PSOPRVKY",1:"PSOPUBKY")
  1.  K ^TMP(NMSPC,$J)
  1.  F LINE=1:1 Q:'$D(KEYTXT(LINE))  D
  1.  . S ^TMP(NMSPC,$J,LINE)=$$DECRYP^XUSRB1(KEYTXT(LINE))
  1.  I $D(^TMP(NMSPC,$J)) D
  1.  . S ^TMP(NMSPC,$J,0)=$$GET1^DIQ(58.41,STATEIEN,18,"I")_"^"_$$GET1^DIQ(58.41,STATEIEN,19,"I")
  1.  Q
  1.  ;
  1. VIEW(STATEIEN) ; Displays the SSH Public Key
  1.  ;Input: (r) STATEIEN - State to display the Public SSH Key for
  1.  ;       ^TMP("PSOPUBKY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
  1.  ;       ^TMP("PSOPUBKY",$J,1-N)=[SSH Key Content]
  1.  N SSHKEY,DASHLN
  1.  I '$G(STATEIEN) Q
  1.  S SSHKEY=$$OPENSSH(),$P(DASHLN,"-",81)=""
  1.  W !,$$GET1^DIQ(5,STATEIEN,.01),"'s Public SSH Key (",$P($G(^TMP("PSOPUBKY",$J,0)),"^",2),") content (does not include dash lines):"
  1.  W !,DASHLN
  1.  F  Q:$L(SSHKEY)=0  W !,$E(SSHKEY,1,80) S SSHKEY=$E(SSHKEY,81,9999)
  1.  W !,DASHLN
  1.  Q
  1.  ;
  1. DELETE(STATEIEN) ; Delete Both SSH Keys associated with the State
  1.  ;Input: (r) STATEIEN - State from what the key should be deleted from in the SPMP STATE PARAMETERS file (#58.41)
  1.  N DIE,DA,DR
  1.  S DIE="^PS(58.41,",DA=+$G(STATEIEN),DR="18///@;19///@;100///@;200///@" D ^DIE
  1.  K ^TMP("PSOPRVKY",$J),^TMP("PSOPUBKY",$J)
  1.  Q
  1.  ;
  1. OPENSSH() ; Returns the SSH Public Key in OpenSSH Format (Converts if necessary)
  1.  ;Input: ^TMP("PSOPUBKY",$J,0)="SSH Key Format (SSH2 / OpenSSH)^Encryption Type (DSA / RSA)"
  1.  ;       ^TMP("PSOPUBKY",$J,1-N)=[SSH Key Content]
  1.  N OPENSSH,ENCRTYPE,LINE
  1.  S OPENSSH=""
  1.  I $P($G(^TMP("PSOPUBKY",$J,0)),"^",1)="SSH2" D
  1.  . S ENCRTYPE=$P($G(^TMP("PSOPUBKY",$J,0)),"^",2),OPENSSH=""
  1.  . F LINE=5:1 Q:'$D(^TMP("PSOPUBKY",$J,LINE))  D
  1.  . . I $G(^TMP("PSOPUBKY",$J,LINE))["---- END" Q
  1.  . . S OPENSSH=OPENSSH_$G(^TMP("PSOPUBKY",$J,LINE))
  1.  . S OPENSSH=$S(ENCRTYPE="RSA":"ssh-rsa",1:"ssh-dss")_" "_OPENSSH
  1.  E  D
  1.  . F LINE=1:1 Q:'$D(^TMP("PSOPUBKY",$J,LINE))  D
  1.  . . S OPENSSH=OPENSSH_$G(^TMP("PSOPUBKY",$J,LINE))
  1.  Q OPENSSH
  1.  ;
  1. BKENDOS() ; Returns the Backend Server Operating System (OS)
  1.  ;Output: Backend Operating System (e.,g., "VMS", "UNIX")
  1.  N BKENDOS,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,I
  1.  K ^XTMP("PSOSPMKY",$J,"OS")
  1.  S BKENDOS="",ZTRTN="SETOS^PSOSPMKY("_$J_")",ZTIO=""
  1.  S ZTDESC="State Prescription Monitoring Program (SPMP) Backend Server OS Check"
  1.  S ZTDTH=$$NOW^XLFDT() D ^%ZTLOAD
  1.  F I=1:1:5 S BKENDOS=$G(^XTMP("PSOSPMKY",$J,"OS")) Q:BKENDOS'=""  H 1
  1.  K ^XTMP("PSOSPMKY",$J,"OS")
  1.  Q $S(BKENDOS'="":BKENDOS,1:$$OS^%ZOSV())
  1.  ;
  1. SETOS(JOB) ; Sets the Operating Systems in ^XTMP("PSOSPMKY",$J,"OS") (Called via Taskman)
  1.  ;Input: JOB - $Job value from calling process
  1.  S ^XTMP("PSOSPMKY",JOB,"OS")=$$OS^%ZOSV()
  1.  Q
  1.  ;
  1. HELP ; SSH Key Help Text
  1.  W !!,"Secure SHell (SSH) Encryption Keys are used to automate the data transmission"
  1.  W !,"to the State Prescription Monitoring Programs (SPMPs). Follow the steps below"
  1.  W !,"to successfully setup SPMP transmissions from VistA to the state/vendor server:"
  1.  W !,""
  1.  W !,"Step 1: Select the 'N' (Create New SSH Key Pair) Action and follow the prompts"
  1.  W !,"        to create a new pair of SSH keys. If you already have an existing SSH"
  1.  W !,"        Key Pair you can skip this step. You can check whether you already"
  1.  W !,"        have an existing SSH Key Pair through the 'V' (View Public SSH Key)"
  1.  W !,"        Action."
  1.  W !,""
  1.  ;PSO*7*723 add ECDSA
  1.  W !,"        Encryption Type: DSA, RSA, ECDSA or EDDSA?"
  1.  W !,"        -----------------------------------"
  1.  D ETHELP,PAUSE^PSOSPMU1
  1.  W !!,"Step 2: Share the Public SSH Key content with the state/vendor. In order to"
  1.  W !,"        successfully establish SPMP transmissions the state/vendor will have"
  1.  W !,"        to install/configure the new SSH Key created in step 1 for the"
  1.  W !,"        user id they assigned to your site. Use the 'V' (View Public SSH Key)"
  1.  W !,"        Action to retrieve the content of the Public SSH key. The Public SSH"
  1.  W !,"        Key should not contain line-feed characters, therefore after you copy"
  1.  W !,"        & paste it from the terminal emulator into an email or text editor"
  1.  W !,"        make sure it contains only one line of text (no wrapping)."
  1.  Q
  1. ETHELP ; Encryption Type Help
  1.  W !,"        Digital Signature Algorithm (DSA) (No longer supported) and Rivest,"
  1.  w !,"        Shamir & Adleman (RSA) have been two of the most common encryption"
  1.  W !,"        algorithms used by the IT industry for securely sharing data. "
  1.  ;PSO*7*723 add ECDSA/EDDSA
  1.  W !,"        Elliptic Curve Digital Signature Algorithm (ECDSA) and Edward-curve"
  1.  W !,"        Digital Signature Algorithm (EDDSA) are more complex public key"
  1.  W !,"        cryptography encryption algorithms that are now supported by the VA."
  1.  W !,"        Many of SPMP servers can handle all types; however there are vendors"
  1.  W !,"        that accept only one specific type. You will need to contact the SPMP"
  1.  W !,"        vendor support to determine which type to select.  If ECDSA is selected"
  1.  W !,"        you will be prompted to enter the Bit size.  Valid selections are 256,"
  1.  W !,"        384 or 521."
  1.  Q