PSNOSKEY ;BIR/SJA-PPS-N SSH Key Management ;09/16/2016
;;4.0;NATIONAL DRUG FILE;**513,563,575**; 30 Oct 98;Build 22
;
;SAC EXEMPTION 202402221226-01: Allows the use of the $ZF(-100) function
;
; taken mostly from: PSOSPMKY - State Prescription Monitoring Program - SSH Key Management
;
EN ; -- Entry point
N X,Y,PSNOS,LOCALDIR,X1,DIR,ENCRBITS,PSNDSA
;
ACTION ; -- SSH Key Action
K DIR S DIR("A")="Action"
S DIR(0)="S^V:View Public SSH Key;C:Create New SSH Key Pair;D:Delete SSH Key Pair;H:Help with SSH Keys",DIR("B")="V"
D ^DIR
I $D(DUOUT)!($D(DIRUT)) G END
I Y="C"!(Y="D"),'$D(^XUSEC("PSN PPS COORD",DUZ)) D G ACTION
.W !!,"The PSN PPS COORD security key is required for this action.",$C(7)
K ^TMP("PSNPUBKY",$J) D RETRIEVE("PUB")
I Y="V"!(Y="D"),'$D(^TMP("PSNPUBKY",$J)) D G ACTION
.W !!,"[No SSH Key Pair found]",$C(7) D PAUSE
I Y="C"!(Y="D") D SIG^XUSESIG I X="^"!($G(X1)="") W:$G(X1)="" " SIGNATURE NOT VERIFIED",$C(7) G ACTION
;
; -- View Public SSH Key
I Y="V" W ! D VIEW,PAUSE G ACTION
;
; -- Create New SSH Key Pair
I Y="C" D G ACTION
.I '$$ASK() W !!,"No action taken!",$C(7) Q
.S PSNOS=$$ENDOS()
.S LOCALDIR=$$GET1^DIQ(57.23,1,$S(PSNOS["VMS":1,1:3))
.I LOCALDIR="" D Q
..W !!,"The ",$S(PSNOS["VMS":"OPEN VMS",1:"UNIX/LINUX")," LOCAL DIRECTORY parameter is missing. Please, update it in"
..W !,"the 'PPS-N Site Parameters (Enter/Edit)' option and try again.",$C(7) D PAUSE
.K DIR S DIR("A")="SSH Key Encryption Type",DIR("?")="^D HELP1^PSNOSKEY"
.;PSN*4*575 Add ECDSA
.S PSNDSA=$$GET1^DIQ(57.23,1,11,"I")
.I 'PSNDSA S DIR(0)="S^RSA:Rivest, Shamir & Adleman (RSA)"
.I PSNDSA S DIR(0)="S^RSA:Rivest, Shamir & Adleman (RSA);ECDSA:Elliptic Curve Digital Signature Algorithm (ECDSA)"
.S DIR("B")="RSA" D ^DIR I $D(DUOUT)!($D(DIRUT)) Q
.S ENCRTYPE=Y
. ;p575 prompt for bit size for ECDSA
. I ENCRTYPE="ECDSA" D I $D(DUOUT)!($D(DIRUT)) Q
. . 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."
. . S DIR(0)="S^256:256 bits;384:384 bits;521:521 bits"
. . S DIR("B")="256" D ^DIR
. S ENCRBITS=$S(ENCRTYPE="ECDSA":Y,1:"")
.I $D(^TMP("PSNPUBKY",$J)) D
..W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," You may be overwriting SSH Keys that are currently in use.",$C(7)
.K DIR S DIR("A")="Confirm Creation of SSH Keys",DIR(0)="Y",DIR("B")="NO"
.W ! D ^DIR I $D(DIRUT)!$D(DUOUT)!'Y Q
.;
.; -- Deleting Existing SSH Key
.I $D(^TMP("PSNPUBKY",$J)) D DELETE
.W !!,"Creating New SSH Keys, please wait..."
. ;p575 removing the task off logic, unnecessary
.;N ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK
.;S ZTRTN="NEWKEY^PSNOSKEY("""_ENCRTYPE_""")",ZTIO="",ZTDESC="SSH Key Generation",ZTDTH=$$NOW^XLFDT()
.;D ^%ZTLOAD K ZTSK,^TMP("PSNPUBKY",$J)
.;F I=1:1:30 D RETRIEVE("PUB") Q:$D(^TMP("PSNPUBKY",$J)) H 1
.; -- If unable to create the key via Taskman after 30 seconds, creates them in the foreground
.;I '$D(^TMP("PSNPUBKY",$J)) D
.D NEWKEY(ENCRTYPE),RETRIEVE("PUB")
.I '$D(^TMP("PSNPUBKY",$J)) D
..W !!,"There was a problem with the generation of the new SSH Key Pair."
..W !,"Please try again and if the problem persists contact IT Support.",$C(7) D PAUSE
.E W "Done",$C(7)
;
; -- Delete SSH Key Pair
I Y="D" D G ACTION
.D RETRIEVE("PUB")
.I '$D(^TMP("PSNPUBKY",$J)) W !!,"[No SSH Key Pair found]",$C(7) Q
.W !!,$G(IOBON),"WARNING:",$G(IOBOFF)," You may be deleting SSH Keys that are currently in use.",$C(7)
.K DIR S DIR("A")="Confirm Deletion of SSH Keys",DIR(0)="Y",DIR("B")="NO"
.W ! D ^DIR I $D(DIRUT)!$D(DUOUT)!'Y Q
.W !!,"Deleting SSH Keys..." D DELETE H 1 W "Done",$C(7)
; SSH Key Help
I Y="H" D HELP G ACTION
G ACTION
;
END ;
Q
;
NEWKEY(ENCRTYPE) ; Generate and store a pair of SSH keys
; Input: (o) ENCRTYPE - SSH Encryption Type (DSA/RSA) (Default: RSA)
;
N LOCALDIR,DTE,PSNOS,KEYFILE,PV,FILE2DEL,LN,OVFLN,PSNSPC,KYTXT,SAVEKEY,DIE,DR,DA
S PSNOS=$$OS^%ZOSV()
S LOCALDIR=$$GET1^DIQ(57.23,1,$S(PSNOS["VMS":1,1:3)) I LOCALDIR="" Q ;Error: Missing directory
;PSN*4*575 handle ECDSA
;I $G(ENCRTYPE)'="RSA" S ENCRTYPE="DSA"
S ENCRTYPE=$S($G(ENCRTYPE)="ECDSA":"ECDSA",1:"RSA")
; -- LOCK to avoid OS files overwrite
F S DTE=+$$FMTHL7^XLFDT($$HTFM^XLFDT($H)) S KEYFILE="KY"_DTE L +@KEYFILE:0 Q:$T H 2
; -- Deleting existing SSH Keys first
D DELETE
;
; -- OpenVMS SSH Key Generation
I PSNOS["VMS" D
.N COMFILE S COMFILE="COM"_DTE_".COM"
.D OPEN^%ZISH("COMFILE",LOCALDIR,COMFILE,"W")
.D USE^%ZISUTL("COMFILE")
.W "SSH_KEYGEN == ""$SYS$SYSTEM:TCPIP$SSH_SSH-KEYGEN2.EXE""",!
.W "SSH_KEYGEN -t "_$$LOW^XLFSTR($G(ENCRTYPE))_" -""P"" "_LOCALDIR_KEYFILE,!
.D CLOSE^%ZISH("COMFILE")
.X "S PV=$ZF(-1,""@"_LOCALDIR_COMFILE_""")"
.S FILE2DEL(COMFILE)="",FILE2DEL(KEYFILE_".")="",FILE2DEL(KEYFILE_".PUB")=""
;
; -- Linux/Unix SSH Key Generation
I PSNOS["UNIX" D
.I '$$DIREXIST^PSNFTP2(LOCALDIR) D MAKEDIR^PSNFTP2(LOCALDIR)
. S ENCRBITS=$S($G(ENCRBITS):ENCRBITS,1:"")
. S ENCRTYPE=$$LOW^XLFSTR($G(ENCRTYPE))
. I ($P($$VERSION^%ZOSV(1),"/",1)[("Cache")) D
. . S:ENCRBITS ENCRBITS=" -b "_ENCRBITS
. . X "S PV=$ZF(-1,""ssh-keygen -q -N '' -C '' -t "_$$LOW^XLFSTR($G(ENCRTYPE))_" -f "_LOCALDIR_KEYFILE_ENCRBITS_""")"
. I $P($$VERSION^%ZOSV(1),"/",1)'[("Cache") D
. . I ENCRBITS S PV=$ZF(-100,"","ssh-keygen","-q","-t",ENCRTYPE,"-b",ENCRBITS,"-f",LOCALDIR_KEYFILE,"-N","","-C","")
. . I ENCRBITS="" S PV=$ZF(-100,"","ssh-keygen","-q","-t",ENCRTYPE,"-f",LOCALDIR_KEYFILE,"-N","","-C","")
.S FILE2DEL(KEYFILE)="",FILE2DEL(KEYFILE_".pub")=""
;
K ^TMP("PSNPRVKY",$J),^TMP("PSNPUBKY",$J)
; -- Retrieving SSH Private Key Content
S X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$S(PSNOS["VMS":".",1:""),$NAME(^TMP("PSNPRVKY",$J,1)),3)
I '$D(^TMP("PSNPRVKY",$J,1)) Q
; -- Retrieving SSH Public Key Content
S X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$S(PSNOS["VMS":".PUB",1:".pub"),$NAME(^TMP("PSNPUBKY",$J,1)),3)
I '$D(^TMP("PSNPUBKY",$J,1)) Q
;
; -- Deleting temporary files used to generate the keys
D DEL^%ZISH(LOCALDIR,"FILE2DEL")
;
; -- Saving new SSH Keys content in the PPS-N UPDATE CONTROL file (#57.23)
F PSNSPC="PSNPRVKY","PSNPUBKY" D
.K KYTXT,SAVEKEY
.F LN=1:1 Q:'$D(^TMP(PSNSPC,$J,LN)) D
..; Unix/Linux Public SSH Key has no line-feed
..I PSNOS["UNIX",PSNSPC="PSNPUBKY" D Q
...S KYTXT(1)=^TMP(PSNSPC,$J,LN)
...F OVFLN=1:1 Q:'$D(^TMP(PSNSPC,$J,LN,"OVF",OVFLN)) D
....S KYTXT(1)=$G(KYTXT(1))_^TMP(PSNSPC,$J,LN,"OVF",OVFLN)
..S KYTXT(LN)=$$ENCRYP^XUSRB1(^TMP(PSNSPC,$J,LN))
.I PSNOS["UNIX",PSNSPC="PSNPUBKY" S KYTXT(1)=$$ENCRYP^XUSRB1(KYTXT(1))
.S SAVEKEY(57.23,"1,",$S(PSNSPC="PSNPRVKY":33,1:34))="KYTXT"
.D UPDATE^DIE("","SAVEKEY")
.K ^TMP(PSNSPC,$J)
;
; -- Saving SSH Key Format (SSH2/OpenSSH) and Encryption Type (DSA/RSA) fields
K DIE S DIE="^PS(57.23,",DA=1
S DR="39///"_$S(PSNOS["VMS":"SSH2",1:"OSSH")_";41///"_ENCRTYPE D ^DIE
L -@KEYFILE
Q
;
RETRIEVE(KTYPE) ; Retrieve the SSH Key into the ^TMP global
; (o) KTYPE - SSH Key Type (PUB - Public/PRV - PRivate) (Default: Public)
;Output: ^TMP("PSN[PUB/PRV]KY",$J,0)="SSH Key Format (SSH2/OpenSSH)^Encryption Type (DSA/RSA)"
; ^TMP("PSN[PUB/PRV]KY",$J,1-N)=[SSH Key Content]
;
N X,LN,KYTXT,PSNSPC
I $G(KTYPE)'="PRV" S KTYPE="PUB"
S X=$$GET1^DIQ(57.23,"1,",$S(KTYPE="PRV":33,1:34),,"KYTXT")
S PSNSPC=$S(KTYPE="PRV":"PSNPRVKY",1:"PSNPUBKY")
K ^TMP(PSNSPC,$J)
F LN=1:1 Q:'$D(KYTXT(LN)) S ^TMP(PSNSPC,$J,LN)=$$DECRYP^XUSRB1(KYTXT(LN))
I $D(^TMP(PSNSPC,$J)) D
.S ^TMP(PSNSPC,$J,0)=$$GET1^DIQ(57.23,1,39,"I")_"^"_$$GET1^DIQ(57.23,1,41,"I")
Q
;
VIEW ; Displays the SSH Public Key
; ^TMP("PSNPUBKY",$J,0)="SSH Key Format (SSH2/OpenSSH)^Encryption Type (DSA/RSA)"
; ^TMP("PSNPUBKY",$J,1-N)=[SSH Key Content]
N SSHKEY,DASHLN
S $P(DASHLN,"-",81)="",SSHKEY=$$OPENSSH()
W !,"Public SSH Key (",$P($G(^TMP("PSNPUBKY",$J,0)),"^",2),") content (does not include dash lines):"
W !,DASHLN
F Q:$L(SSHKEY)=0 W !,$E(SSHKEY,1,80) S SSHKEY=$E(SSHKEY,81,9999)
W !,DASHLN
Q
;
DELETE ; Delete Both SSH Keys associated
N DIE,DA,DR
S DIE="^PS(57.23,",DA=1,DR="39///@;41///@;33///@;34///@" D ^DIE
K ^TMP("PSNPRVKY",$J),^TMP("PSNPUBKY",$J)
Q
;
OPENSSH() ; Returns the SSH Public Key in OpenSSH Format (Converts if necessary)
;Input: ^TMP("PSNPUBKY",$J,0)="SSH Key Format (SSH2/OpenSSH)^Encryption Type (DSA/RSA)"
; ^TMP("PSNPUBKY",$J,1-N)=[SSH Key Content]
;
N OPENSSH,ENCRTYPE,LN
S OPENSSH=""
I $P($G(^TMP("PSNPUBKY",$J,0)),"^")="SSH2" D
.S ENCRTYPE=$P($G(^TMP("PSNPUBKY",$J,0)),"^",2),OPENSSH=""
.F LN=5:1 Q:'$D(^TMP("PSNPUBKY",$J,LN)) D
..I $G(^TMP("PSNPUBKY",$J,LN))["---- END" Q
..S OPENSSH=OPENSSH_$G(^TMP("PSNPUBKY",$J,LN))
.S OPENSSH=$S(ENCRTYPE="RSA":"ssh-rsa",1:"ssh-dss")_" "_OPENSSH
E D
.F LN=1:1 Q:'$D(^TMP("PSNPUBKY",$J,LN)) D
..S OPENSSH=OPENSSH_$G(^TMP("PSNPUBKY",$J,LN))
Q OPENSSH
;
ENDOS() ; Returns the Backend Server Operating System (OS)
;Output: Backend Operating System (e.,g., "VMS", "UNIX")
;
N ENDOS,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,I
K ^XTMP("PSNKEY",$J,"OS")
S ENDOS="",ZTRTN="SETOS^PSNOSKEY("_$J_")",ZTIO=""
S ZTDESC="Backend Server OS Check"
S ZTDTH=$$NOW^XLFDT() D ^%ZTLOAD
F I=1:1:5 S ENDOS=$G(^XTMP("PSNKEY",$J,"OS")) Q:ENDOS'="" H 1
K ^XTMP("PSNKEY",$J,"OS")
Q $S(ENDOS'="":ENDOS,1:$$OS^%ZOSV())
;
SETOS(JOB) ; Sets the Operating Systems in ^XTMP("PSNKEY",$J,"OS") (Called via Taskman)
;Input: JOB - $Job value from calling process
S ^XTMP("PSNKEY",JOB,"OS")=$$OS^%ZOSV()
Q
;
;PSN*4*575 UPDATE HELP TEXT WORDING FOR ECDSA
HELP ; Encryption Type Help
W !!,"Secure SHell (SSH) Encryption Keys are used to allow data file download."
W !,"Follow the steps below to successfully setup data file download from Austin "
W !,"server to VistA sites:",!
W !,"Step 1: Select the 'C' (Create New SSH Key Pair) Action and follow the prompts"
W !," to create a new pair of SSH keys. If you already have an existing SSH"
W !," Key Pair you can skip this step."
W !," You can check whether you already have an existing SSH Key Pair"
W !," through the 'V' (View Public SSH Key) Action."
W !,""
D HELP1,PAUSE
W !!,"Step 2: Share the Public SSH Key content with the PPS-N SFTP server (Austin)."
W !," In order to successfully establish the data download files, the SFTP "
W !," server at Austin needs to install/configure the new SSH Key created in"
W !," step 1 for the user id they assigned to your site. Use the 'V' (View "
W !," Public SSH Key) Action to retrieve the content of the Public SSH key."
W !," The Public SSH Key should not contain line-feed characters, therefore "
W !," after you copy & paste it from the terminal emulator into an email or "
W !," text editor make sure it contains only one line of text (no wrapping)."
Q
;
HELP1 ; Encryption Type Help
W !," Encryption Type: RSA or ECDSA?"
W !," -----------------------------------"
W !," Rivest, Shamir & Adleman (RSA) has been one of the most common"
W !," encryption algorithms used by the IT industry for securely sharing data."
W !,""
W !," Elliptic Curve Digital Signature Algorithm (ECDSA) is a more complex"
W !," public key cryptography encryption algorithm that is now supported by"
W !," the VA. If ECDSA is selected you will be prompted to enter the Bit size."
W !," Valid selections are 256, 384 or 521."
W !,""
W !," You will need to contact the Austin SFTP server support to determine"
W !," which type to select."
Q
PAUSE ; Pauses screen until user hits Return
W ! K DIR S DIR("A")="Press Return to continue",DIR(0)="E" D ^DIR
Q
;
ASK() ; confirm creating new pair
N Y S Y=0 Q:'$D(^TMP("PSNPUBKY",$J)) 1
K DIRUT,DUOUT,DIR,X,Y S DIR(0)="Y",DIR("?")="Please enter Y or N."
S DIR("A")="Do you want to delete existing key pair and create new pair" W !!
S DIR("B")="NO" D ^DIR
Q Y
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HPSNOSKEY 12146 printed Sep 23, 2025@20:00:28 Page 2
PSNOSKEY ;BIR/SJA-PPS-N SSH Key Management ;09/16/2016
+1 ;;4.0;NATIONAL DRUG FILE;**513,563,575**; 30 Oct 98;Build 22
+2 ;
+3 ;SAC EXEMPTION 202402221226-01: Allows the use of the $ZF(-100) function
+4 ;
+5 ; taken mostly from: PSOSPMKY - State Prescription Monitoring Program - SSH Key Management
+6 ;
EN ; -- Entry point
+1 NEW X,Y,PSNOS,LOCALDIR,X1,DIR,ENCRBITS,PSNDSA
+2 ;
ACTION ; -- SSH Key Action
+1 KILL DIR
SET DIR("A")="Action"
+2 SET DIR(0)="S^V:View Public SSH Key;C:Create New SSH Key Pair;D:Delete SSH Key Pair;H:Help with SSH Keys"
SET DIR("B")="V"
+3 DO ^DIR
+4 IF $DATA(DUOUT)!($DATA(DIRUT))
GOTO END
+5 IF Y="C"!(Y="D")
IF '$DATA(^XUSEC("PSN PPS COORD",DUZ))
Begin DoDot:1
+6 WRITE !!,"The PSN PPS COORD security key is required for this action.",$CHAR(7)
End DoDot:1
GOTO ACTION
+7 KILL ^TMP("PSNPUBKY",$JOB)
DO RETRIEVE("PUB")
+8 IF Y="V"!(Y="D")
IF '$DATA(^TMP("PSNPUBKY",$JOB))
Begin DoDot:1
+9 WRITE !!,"[No SSH Key Pair found]",$CHAR(7)
DO PAUSE
End DoDot:1
GOTO ACTION
+10 IF Y="C"!(Y="D")
DO SIG^XUSESIG
IF X="^"!($GET(X1)="")
if $GET(X1)=""
WRITE " SIGNATURE NOT VERIFIED",$CHAR(7)
GOTO ACTION
+11 ;
+12 ; -- View Public SSH Key
+13 IF Y="V"
WRITE !
DO VIEW
DO PAUSE
GOTO ACTION
+14 ;
+15 ; -- Create New SSH Key Pair
+16 IF Y="C"
Begin DoDot:1
+17 IF '$$ASK()
WRITE !!,"No action taken!",$CHAR(7)
QUIT
+18 SET PSNOS=$$ENDOS()
+19 SET LOCALDIR=$$GET1^DIQ(57.23,1,$SELECT(PSNOS["VMS":1,1:3))
+20 IF LOCALDIR=""
Begin DoDot:2
+21 WRITE !!,"The ",$SELECT(PSNOS["VMS":"OPEN VMS",1:"UNIX/LINUX")," LOCAL DIRECTORY parameter is missing. Please, update it in"
+22 WRITE !,"the 'PPS-N Site Parameters (Enter/Edit)' option and try again.",$CHAR(7)
DO PAUSE
End DoDot:2
QUIT
+23 KILL DIR
SET DIR("A")="SSH Key Encryption Type"
SET DIR("?")="^D HELP1^PSNOSKEY"
+24 ;PSN*4*575 Add ECDSA
+25 SET PSNDSA=$$GET1^DIQ(57.23,1,11,"I")
+26 IF 'PSNDSA
SET DIR(0)="S^RSA:Rivest, Shamir & Adleman (RSA)"
+27 IF PSNDSA
SET DIR(0)="S^RSA:Rivest, Shamir & Adleman (RSA);ECDSA:Elliptic Curve Digital Signature Algorithm (ECDSA)"
+28 SET DIR("B")="RSA"
DO ^DIR
IF $DATA(DUOUT)!($DATA(DIRUT))
QUIT
+29 SET ENCRTYPE=Y
+30 ;p575 prompt for bit size for ECDSA
+31 IF ENCRTYPE="ECDSA"
Begin DoDot:2
+32 KILL DIR
SET DIR("A")="ECDSA encryption key size (bit size)"
SET DIR("?")="Available key sizes are 256 bits, 384 bits, or 521 bits. Also referred to as key length."
+33 SET DIR(0)="S^256:256 bits;384:384 bits;521:521 bits"
+34 SET DIR("B")="256"
DO ^DIR
End DoDot:2
IF $DATA(DUOUT)!($DATA(DIRUT))
QUIT
+35 SET ENCRBITS=$SELECT(ENCRTYPE="ECDSA":Y,1:"")
+36 IF $DATA(^TMP("PSNPUBKY",$JOB))
Begin DoDot:2
+37 WRITE !!,$GET(IOBON),"WARNING:",$GET(IOBOFF)," You may be overwriting SSH Keys that are currently in use.",$CHAR(7)
End DoDot:2
+38 KILL DIR
SET DIR("A")="Confirm Creation of SSH Keys"
SET DIR(0)="Y"
SET DIR("B")="NO"
+39 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DUOUT)!'Y
QUIT
+40 ;
+41 ; -- Deleting Existing SSH Key
+42 IF $DATA(^TMP("PSNPUBKY",$JOB))
DO DELETE
+43 WRITE !!,"Creating New SSH Keys, please wait..."
+44 ;p575 removing the task off logic, unnecessary
+45 ;N ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK
+46 ;S ZTRTN="NEWKEY^PSNOSKEY("""_ENCRTYPE_""")",ZTIO="",ZTDESC="SSH Key Generation",ZTDTH=$$NOW^XLFDT()
+47 ;D ^%ZTLOAD K ZTSK,^TMP("PSNPUBKY",$J)
+48 ;F I=1:1:30 D RETRIEVE("PUB") Q:$D(^TMP("PSNPUBKY",$J)) H 1
+49 ; -- If unable to create the key via Taskman after 30 seconds, creates them in the foreground
+50 ;I '$D(^TMP("PSNPUBKY",$J)) D
+51 DO NEWKEY(ENCRTYPE)
DO RETRIEVE("PUB")
+52 IF '$DATA(^TMP("PSNPUBKY",$JOB))
Begin DoDot:2
+53 WRITE !!,"There was a problem with the generation of the new SSH Key Pair."
+54 WRITE !,"Please try again and if the problem persists contact IT Support.",$CHAR(7)
DO PAUSE
End DoDot:2
+55 IF '$TEST
WRITE "Done",$CHAR(7)
End DoDot:1
GOTO ACTION
+56 ;
+57 ; -- Delete SSH Key Pair
+58 IF Y="D"
Begin DoDot:1
+59 DO RETRIEVE("PUB")
+60 IF '$DATA(^TMP("PSNPUBKY",$JOB))
WRITE !!,"[No SSH Key Pair found]",$CHAR(7)
QUIT
+61 WRITE !!,$GET(IOBON),"WARNING:",$GET(IOBOFF)," You may be deleting SSH Keys that are currently in use.",$CHAR(7)
+62 KILL DIR
SET DIR("A")="Confirm Deletion of SSH Keys"
SET DIR(0)="Y"
SET DIR("B")="NO"
+63 WRITE !
DO ^DIR
IF $DATA(DIRUT)!$DATA(DUOUT)!'Y
QUIT
+64 WRITE !!,"Deleting SSH Keys..."
DO DELETE
HANG 1
WRITE "Done",$CHAR(7)
End DoDot:1
GOTO ACTION
+65 ; SSH Key Help
+66 IF Y="H"
DO HELP
GOTO ACTION
+67 GOTO ACTION
+68 ;
END ;
+1 QUIT
+2 ;
NEWKEY(ENCRTYPE) ; Generate and store a pair of SSH keys
+1 ; Input: (o) ENCRTYPE - SSH Encryption Type (DSA/RSA) (Default: RSA)
+2 ;
+3 NEW LOCALDIR,DTE,PSNOS,KEYFILE,PV,FILE2DEL,LN,OVFLN,PSNSPC,KYTXT,SAVEKEY,DIE,DR,DA
+4 SET PSNOS=$$OS^%ZOSV()
+5 ;Error: Missing directory
SET LOCALDIR=$$GET1^DIQ(57.23,1,$SELECT(PSNOS["VMS":1,1:3))
IF LOCALDIR=""
QUIT
+6 ;PSN*4*575 handle ECDSA
+7 ;I $G(ENCRTYPE)'="RSA" S ENCRTYPE="DSA"
+8 SET ENCRTYPE=$SELECT($GET(ENCRTYPE)="ECDSA":"ECDSA",1:"RSA")
+9 ; -- LOCK to avoid OS files overwrite
+10 FOR
SET DTE=+$$FMTHL7^XLFDT($$HTFM^XLFDT($HOROLOG))
SET KEYFILE="KY"_DTE
LOCK +@KEYFILE:0
if $TEST
QUIT
HANG 2
+11 ; -- Deleting existing SSH Keys first
+12 DO DELETE
+13 ;
+14 ; -- OpenVMS SSH Key Generation
+15 IF PSNOS["VMS"
Begin DoDot:1
+16 NEW COMFILE
SET COMFILE="COM"_DTE_".COM"
+17 DO OPEN^%ZISH("COMFILE",LOCALDIR,COMFILE,"W")
+18 DO USE^%ZISUTL("COMFILE")
+19 WRITE "SSH_KEYGEN == ""$SYS$SYSTEM:TCPIP$SSH_SSH-KEYGEN2.EXE""",!
+20 WRITE "SSH_KEYGEN -t "_$$LOW^XLFSTR($GET(ENCRTYPE))_" -""P"" "_LOCALDIR_KEYFILE,!
+21 DO CLOSE^%ZISH("COMFILE")
+22 XECUTE "S PV=$ZF(-1,""@"_LOCALDIR_COMFILE_""")"
+23 SET FILE2DEL(COMFILE)=""
SET FILE2DEL(KEYFILE_".")=""
SET FILE2DEL(KEYFILE_".PUB")=""
End DoDot:1
+24 ;
+25 ; -- Linux/Unix SSH Key Generation
+26 IF PSNOS["UNIX"
Begin DoDot:1
+27 IF '$$DIREXIST^PSNFTP2(LOCALDIR)
DO MAKEDIR^PSNFTP2(LOCALDIR)
+28 SET ENCRBITS=$SELECT($GET(ENCRBITS):ENCRBITS,1:"")
+29 SET ENCRTYPE=$$LOW^XLFSTR($GET(ENCRTYPE))
+30 IF ($PIECE($$VERSION^%ZOSV(1),"/",1)[("Cache"))
Begin DoDot:2
+31 if ENCRBITS
SET ENCRBITS=" -b "_ENCRBITS
+32 XECUTE "S PV=$ZF(-1,""ssh-keygen -q -N '' -C '' -t "_$$LOW^XLFSTR($GET(ENCRTYPE))_" -f "_LOCALDIR_KEYFILE_ENCRBITS_""")"
End DoDot:2
+33 IF $PIECE($$VERSION^%ZOSV(1),"/",1)'[("Cache")
Begin DoDot:2
+34 IF ENCRBITS
SET PV=$ZF(-100,"","ssh-keygen","-q","-t",ENCRTYPE,"-b",ENCRBITS,"-f",LOCALDIR_KEYFILE,"-N","","-C","")
+35 IF ENCRBITS=""
SET PV=$ZF(-100,"","ssh-keygen","-q","-t",ENCRTYPE,"-f",LOCALDIR_KEYFILE,"-N","","-C","")
End DoDot:2
+36 SET FILE2DEL(KEYFILE)=""
SET FILE2DEL(KEYFILE_".pub")=""
End DoDot:1
+37 ;
+38 KILL ^TMP("PSNPRVKY",$JOB),^TMP("PSNPUBKY",$JOB)
+39 ; -- Retrieving SSH Private Key Content
+40 SET X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$SELECT(PSNOS["VMS":".",1:""),$NAME(^TMP("PSNPRVKY",$JOB,1)),3)
+41 IF '$DATA(^TMP("PSNPRVKY",$JOB,1))
QUIT
+42 ; -- Retrieving SSH Public Key Content
+43 SET X=$$FTG^%ZISH(LOCALDIR,KEYFILE_$SELECT(PSNOS["VMS":".PUB",1:".pub"),$NAME(^TMP("PSNPUBKY",$JOB,1)),3)
+44 IF '$DATA(^TMP("PSNPUBKY",$JOB,1))
QUIT
+45 ;
+46 ; -- Deleting temporary files used to generate the keys
+47 DO DEL^%ZISH(LOCALDIR,"FILE2DEL")
+48 ;
+49 ; -- Saving new SSH Keys content in the PPS-N UPDATE CONTROL file (#57.23)
+50 FOR PSNSPC="PSNPRVKY","PSNPUBKY"
Begin DoDot:1
+51 KILL KYTXT,SAVEKEY
+52 FOR LN=1:1
if '$DATA(^TMP(PSNSPC,$JOB,LN))
QUIT
Begin DoDot:2
+53 ; Unix/Linux Public SSH Key has no line-feed
+54 IF PSNOS["UNIX"
IF PSNSPC="PSNPUBKY"
Begin DoDot:3
+55 SET KYTXT(1)=^TMP(PSNSPC,$JOB,LN)
+56 FOR OVFLN=1:1
if '$DATA(^TMP(PSNSPC,$JOB,LN,"OVF",OVFLN))
QUIT
Begin DoDot:4
+57 SET KYTXT(1)=$GET(KYTXT(1))_^TMP(PSNSPC,$JOB,LN,"OVF",OVFLN)
End DoDot:4
End DoDot:3
QUIT
+58 SET KYTXT(LN)=$$ENCRYP^XUSRB1(^TMP(PSNSPC,$JOB,LN))
End DoDot:2
+59 IF PSNOS["UNIX"
IF PSNSPC="PSNPUBKY"
SET KYTXT(1)=$$ENCRYP^XUSRB1(KYTXT(1))
+60 SET SAVEKEY(57.23,"1,",$SELECT(PSNSPC="PSNPRVKY":33,1:34))="KYTXT"
+61 DO UPDATE^DIE("","SAVEKEY")
+62 KILL ^TMP(PSNSPC,$JOB)
End DoDot:1
+63 ;
+64 ; -- Saving SSH Key Format (SSH2/OpenSSH) and Encryption Type (DSA/RSA) fields
+65 KILL DIE
SET DIE="^PS(57.23,"
SET DA=1
+66 SET DR="39///"_$SELECT(PSNOS["VMS":"SSH2",1:"OSSH")_";41///"_ENCRTYPE
DO ^DIE
+67 LOCK -@KEYFILE
+68 QUIT
+69 ;
RETRIEVE(KTYPE) ; Retrieve the SSH Key into the ^TMP global
+1 ; (o) KTYPE - SSH Key Type (PUB - Public/PRV - PRivate) (Default: Public)
+2 ;Output: ^TMP("PSN[PUB/PRV]KY",$J,0)="SSH Key Format (SSH2/OpenSSH)^Encryption Type (DSA/RSA)"
+3 ; ^TMP("PSN[PUB/PRV]KY",$J,1-N)=[SSH Key Content]
+4 ;
+5 NEW X,LN,KYTXT,PSNSPC
+6 IF $GET(KTYPE)'="PRV"
SET KTYPE="PUB"
+7 SET X=$$GET1^DIQ(57.23,"1,",$SELECT(KTYPE="PRV":33,1:34),,"KYTXT")
+8 SET PSNSPC=$SELECT(KTYPE="PRV":"PSNPRVKY",1:"PSNPUBKY")
+9 KILL ^TMP(PSNSPC,$JOB)
+10 FOR LN=1:1
if '$DATA(KYTXT(LN))
QUIT
SET ^TMP(PSNSPC,$JOB,LN)=$$DECRYP^XUSRB1(KYTXT(LN))
+11 IF $DATA(^TMP(PSNSPC,$JOB))
Begin DoDot:1
+12 SET ^TMP(PSNSPC,$JOB,0)=$$GET1^DIQ(57.23,1,39,"I")_"^"_$$GET1^DIQ(57.23,1,41,"I")
End DoDot:1
+13 QUIT
+14 ;
VIEW ; Displays the SSH Public Key
+1 ; ^TMP("PSNPUBKY",$J,0)="SSH Key Format (SSH2/OpenSSH)^Encryption Type (DSA/RSA)"
+2 ; ^TMP("PSNPUBKY",$J,1-N)=[SSH Key Content]
+3 NEW SSHKEY,DASHLN
+4 SET $PIECE(DASHLN,"-",81)=""
SET SSHKEY=$$OPENSSH()
+5 WRITE !,"Public SSH Key (",$PIECE($GET(^TMP("PSNPUBKY",$JOB,0)),"^",2),") content (does not include dash lines):"
+6 WRITE !,DASHLN
+7 FOR
if $LENGTH(SSHKEY)=0
QUIT
WRITE !,$EXTRACT(SSHKEY,1,80)
SET SSHKEY=$EXTRACT(SSHKEY,81,9999)
+8 WRITE !,DASHLN
+9 QUIT
+10 ;
DELETE ; Delete Both SSH Keys associated
+1 NEW DIE,DA,DR
+2 SET DIE="^PS(57.23,"
SET DA=1
SET DR="39///@;41///@;33///@;34///@"
DO ^DIE
+3 KILL ^TMP("PSNPRVKY",$JOB),^TMP("PSNPUBKY",$JOB)
+4 QUIT
+5 ;
OPENSSH() ; Returns the SSH Public Key in OpenSSH Format (Converts if necessary)
+1 ;Input: ^TMP("PSNPUBKY",$J,0)="SSH Key Format (SSH2/OpenSSH)^Encryption Type (DSA/RSA)"
+2 ; ^TMP("PSNPUBKY",$J,1-N)=[SSH Key Content]
+3 ;
+4 NEW OPENSSH,ENCRTYPE,LN
+5 SET OPENSSH=""
+6 IF $PIECE($GET(^TMP("PSNPUBKY",$JOB,0)),"^")="SSH2"
Begin DoDot:1
+7 SET ENCRTYPE=$PIECE($GET(^TMP("PSNPUBKY",$JOB,0)),"^",2)
SET OPENSSH=""
+8 FOR LN=5:1
if '$DATA(^TMP("PSNPUBKY",$JOB,LN))
QUIT
Begin DoDot:2
+9 IF $GET(^TMP("PSNPUBKY",$JOB,LN))["---- END"
QUIT
+10 SET OPENSSH=OPENSSH_$GET(^TMP("PSNPUBKY",$JOB,LN))
End DoDot:2
+11 SET OPENSSH=$SELECT(ENCRTYPE="RSA":"ssh-rsa",1:"ssh-dss")_" "_OPENSSH
End DoDot:1
+12 IF '$TEST
Begin DoDot:1
+13 FOR LN=1:1
if '$DATA(^TMP("PSNPUBKY",$JOB,LN))
QUIT
Begin DoDot:2
+14 SET OPENSSH=OPENSSH_$GET(^TMP("PSNPUBKY",$JOB,LN))
End DoDot:2
End DoDot:1
+15 QUIT OPENSSH
+16 ;
ENDOS() ; Returns the Backend Server Operating System (OS)
+1 ;Output: Backend Operating System (e.,g., "VMS", "UNIX")
+2 ;
+3 NEW ENDOS,ZTRTN,ZTIO,ZTDESC,ZTDTH,ZTSK,I
+4 KILL ^XTMP("PSNKEY",$JOB,"OS")
+5 SET ENDOS=""
SET ZTRTN="SETOS^PSNOSKEY("_$JOB_")"
SET ZTIO=""
+6 SET ZTDESC="Backend Server OS Check"
+7 SET ZTDTH=$$NOW^XLFDT()
DO ^%ZTLOAD
+8 FOR I=1:1:5
SET ENDOS=$GET(^XTMP("PSNKEY",$JOB,"OS"))
if ENDOS'=""
QUIT
HANG 1
+9 KILL ^XTMP("PSNKEY",$JOB,"OS")
+10 QUIT $SELECT(ENDOS'="":ENDOS,1:$$OS^%ZOSV())
+11 ;
SETOS(JOB) ; Sets the Operating Systems in ^XTMP("PSNKEY",$J,"OS") (Called via Taskman)
+1 ;Input: JOB - $Job value from calling process
+2 SET ^XTMP("PSNKEY",JOB,"OS")=$$OS^%ZOSV()
+3 QUIT
+4 ;
+5 ;PSN*4*575 UPDATE HELP TEXT WORDING FOR ECDSA
HELP ; Encryption Type Help
+1 WRITE !!,"Secure SHell (SSH) Encryption Keys are used to allow data file download."
+2 WRITE !,"Follow the steps below to successfully setup data file download from Austin "
+3 WRITE !,"server to VistA sites:",!
+4 WRITE !,"Step 1: Select the 'C' (Create New SSH Key Pair) Action and follow the prompts"
+5 WRITE !," to create a new pair of SSH keys. If you already have an existing SSH"
+6 WRITE !," Key Pair you can skip this step."
+7 WRITE !," You can check whether you already have an existing SSH Key Pair"
+8 WRITE !," through the 'V' (View Public SSH Key) Action."
+9 WRITE !,""
+10 DO HELP1
DO PAUSE
+11 WRITE !!,"Step 2: Share the Public SSH Key content with the PPS-N SFTP server (Austin)."
+12 WRITE !," In order to successfully establish the data download files, the SFTP "
+13 WRITE !," server at Austin needs to install/configure the new SSH Key created in"
+14 WRITE !," step 1 for the user id they assigned to your site. Use the 'V' (View "
+15 WRITE !," Public SSH Key) Action to retrieve the content of the Public SSH key."
+16 WRITE !," The Public SSH Key should not contain line-feed characters, therefore "
+17 WRITE !," after you copy & paste it from the terminal emulator into an email or "
+18 WRITE !," text editor make sure it contains only one line of text (no wrapping)."
+19 QUIT
+20 ;
HELP1 ; Encryption Type Help
+1 WRITE !," Encryption Type: RSA or ECDSA?"
+2 WRITE !," -----------------------------------"
+3 WRITE !," Rivest, Shamir & Adleman (RSA) has been one of the most common"
+4 WRITE !," encryption algorithms used by the IT industry for securely sharing data."
+5 WRITE !,""
+6 WRITE !," Elliptic Curve Digital Signature Algorithm (ECDSA) is a more complex"
+7 WRITE !," public key cryptography encryption algorithm that is now supported by"
+8 WRITE !," the VA. If ECDSA is selected you will be prompted to enter the Bit size."
+9 WRITE !," Valid selections are 256, 384 or 521."
+10 WRITE !,""
+11 WRITE !," You will need to contact the Austin SFTP server support to determine"
+12 WRITE !," which type to select."
+13 QUIT
PAUSE ; Pauses screen until user hits Return
+1 WRITE !
KILL DIR
SET DIR("A")="Press Return to continue"
SET DIR(0)="E"
DO ^DIR
+2 QUIT
+3 ;
ASK() ; confirm creating new pair
+1 NEW Y
SET Y=0
if '$DATA(^TMP("PSNPUBKY",$JOB))
QUIT 1
+2 KILL DIRUT,DUOUT,DIR,X,Y
SET DIR(0)="Y"
SET DIR("?")="Please enter Y or N."
+3 SET DIR("A")="Do you want to delete existing key pair and create new pair"
WRITE !!
+4 SET DIR("B")="NO"
DO ^DIR
+5 QUIT Y
