XLFIPV ;ISD/HGW - IPv4 and IPv6 Utilities ; 8/19/20 10:57am
;;8.0;KERNEL;**605,638,736**;Aug 6, 2012;Build 12
;Per VA Directive 6402, this routine should not be modified.
Q
;
VALIDATE(IP) ; EXTRINSIC. ICR #5844 (supported)
; Validate the format of an IP address (either IPv4 or IPv6).
; Usage: S Y=$$VALIDATE^XLFIPV(IP)
; Input: IP (string) - IPv4 or IPv6 Address to be validated.
; Output: returns:
; 1 - if the IP address is in a valid format.
; 0 - if the format is invalid or null input.
;
N I,J,X,XLFIELD
S X=1
I '$D(IP) Q 0
I IP?1.3N1P1.3N1P1.3N1P1.3N1P.N S IP=$P(IP,":",1) ;p638 Strip off port information from IPv4 address
; If IP address contains both ":" and "." delimiters, then check IPv4 embedded in IPv6.
I (IP[":")&(IP[".") D Q X ; IPv4-Mapped.
. S IP=$$EXPAND6(IP,6) I IP="" S X=0 Q ; Change the format of the first six high-order bytes
. F I=1:1:6 Q:X=0 D ; Examine field by field, first six bytes
. . S X=$$EXAMINE6($P(IP,":",I))
. S XLFIELD=$P(IP,":",7) ; Get last two bytes, IPv4 format
. F I=1:1:4 Q:X=0 D ; Examine field by field, last two bytes
. . S X=$$EXAMINE4($P(XLFIELD,".",I))
; If IP address contains ":" delimiter, then IPv6. Otherwise IPv4.
I IP[":" D Q X ; IPv6 address
. S IP=$$EXPAND6(IP,7) I IP="" S X=0 Q ; Change to a common format
. F I=1:1:8 Q:X=0 D ; Examine field by field
. . S X=$$EXAMINE6($P(IP,":",I))
I IP'[":" D Q X ; IPv4 address
. S IP=$$EXPAND4(IP) ; Change to a common format
. F I=1:1:4 Q:X=0 D ; Examine field by field
. . S X=$$EXAMINE4($P(IP,".",I))
Q 0
;
FORCEIP4(IP) ; EXTRINSIC. ICR #5844 (supported)
; Convert an IP address (either IPv4 or IPv6) into an IPv4 address in a standardized format: "127.0.0.1".
; Usage: S Y=$$FORCEIP4^XLFIPV(IP)
; Input: IP (string) IPv4 or IPv6 Address to be converted.
; Output: returns: An IPv4 address in "ddd.ddd.ddd.ddd" notation if the input address is valid and has an
; IPv4 equivalent, or the null address "0.0.0.0" if the input address is invalid, or the null address
; "0.0.0.0" if an IPv6 address is input which does not have an IPv4 equivalent.
;
N I,XLFIELD,XLMAP
; Return null address "0.0.0.0" if address is invalid
Q:'$$VALIDATE(IP) "0.0.0.0"
I IP?1.3N1P1.3N1P1.3N1P1.3N1P.N S IP=$P(IP,":") ;p638 Strip off port information from IPv4 address
S XLMAP="0000:0000:0000:0000:0000:FFFF:"
; If IP address contains both ":" and "." delimiters, then IPv4-Mapped IPv6 address.
I (IP[":")&(IP[".") D Q IP ; IPv4-Mapped.
. S IP=$$EXPAND6(IP,6) I IP="" S IP="0.0.0.0" Q ; Change the format of the first six high-order bytes
. S IP=$$EXPAND4($E(IP,31,49)) ; Get last two bytes, IPv4 format (not interested in first six bytes)
I IP[":" D Q IP ; IPv6 address (last two bytes might be IPv4-Mapped)
. S IP=$$EXPAND6(IP,7) I IP="" S IP="0.0.0.0" Q ; Change the format to standardized
. I IP="0000:0000:0000:0000:0000:0000:0000:0001" S IP="127.0.0.1" Q ; Loopback address
. I $E(IP,1,30)'=XLMAP S IP="0.0.0.0" Q ; Invalid IPv4-Mapped address
. S IP=$$DEC^XLFUTL($E(IP,31,32),16)_"."_$$DEC^XLFUTL($E(IP,33,34),16)_"."_$$DEC^XLFUTL($E(IP,36,37),16)_"."_$$DEC^XLFUTL($E(IP,38,39),16)
I IP'[":" D Q IP ; IPv4 address
. S IP=$$EXPAND4(IP) ; Change to a common format
Q "0.0.0.0"
;
FORCEIP6(IP) ; EXTRINSIC. ICR #5844 (supported)
; Convert an IP address (either IPv4 or IPv6) into an IPv6 address in a standardized format: "2001:0DB8:0000:0000:0000:8A2E:0370:7334".
; Usage: S Y=$$FORCEIP6^XLFIPV(IP)
; Input: IP (string) IPv4 or IPv6 Address to be converted.
; Output: returns: An IPv6 address in "hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh" notation if the
; input address is valid, or the null address "::0" if the input address is invalid.
;
N XLMAP
; Return expanded null address "0000:0000:0000:0000:0000:0000:0000:0000" if address is invalid
Q:'$$VALIDATE(IP) "0000:0000:0000:0000:0000:0000:0000:0000"
S XLMAP="0000:0000:0000:0000:0000:FFFF:"
I IP?1.3N1P1.3N1P1.3N1P1.3N1P.N S IP=$P(IP,":") ;p638 Strip off port information from IPv4 address
; If IP address contains both ":" and "." delimiters, then IPv4 embedded in IPv6.
I (IP[":")&(IP[".") D Q IP ; IPv4-Mapped address.
. S IP=$$EXPAND6(IP,6) I IP="" S IP="0.0.0.0" Q ; Change the format of the first six high-order bytes
. S IP=$E(IP,1,30)_$$CNVF($$EXPAND4($E(IP,31,49))) ; Get last two bytes, IPv4 format -> IPv4-Mapped Address
; If IP address contains ":" delimiter, then IPv6. Otherwise IPv4.
I IP[":" D Q IP ; IPv6 address
. S IP=$$EXPAND6(IP,7) I IP="" S IP="0000:0000:0000:0000:0000:0000:0000:0000" Q ; Change to a common format
I IP'[":" D Q IP ; IPv4 address
. S IP=XLMAP_$$CNVF($$EXPAND4(IP)) ; IPv4-Mapped IPv6 Address
. I IP="0000:0000:0000:0000:0000:FFFF:0000:0000" S IP="0000:0000:0000:0000:0000:0000:0000:0000" Q ; Null address
. I IP="0000:0000:0000:0000:0000:FFFF:7F00:0001" S IP="0000:0000:0000:0000:0000:0000:0000:0001" Q ; Loopback address
Q IP
;
CONVERT(IP) ; EXTRINSIC. ICR #5844 (supported)
; Convert an IP address (either IPv4 or IPv6) into an IPv6 address in a standardized format, either IPv4 or IPv6 depending
; upon the Cache system settings.
; Usage: S Y=$$CONVERT^XLFIPV(IP)
; Input: IP (string) IPv4 or IPv6 Address to be converted.
; Output: returns:
; - An IPv4 address if IPv6 is disabled on the system.
; - An IPv6 address if IPv6 is enabled on the system.
; - An IPv4 or IPv6 null address if the input cannot be converted.
;
N XLV6
S XLV6=$$VERSION() ; Is IPv6 enabled on this system?
I XLV6=1 S IP=$$FORCEIP6(IP) ; Yes
I XLV6=0 S IP=$$FORCEIP4(IP) ; No
Q IP
;
VERSION() ; EXTRINSIC. ICR #5844 (supported)
; Determine the Cache system settings for IPv6.
; Usage: S Y=$$VERSION^XLFIPV()
; Input: None.
; Output: returns:
; 1 - if IPv6 is enabled.
; 0 - if IPv6 is disabled.
;
N %
S %=0
I ($$VERSION^%ZOSV(1)["Cache")!($$VERSION^%ZOSV(1)["IRIS") I +$$VERSION^%ZOSV()>2009 S %=$SYSTEM.Process.IPv6Format()
Q %
;
VAL ; OPTION. "Validate IPv4 and IPv6 address" [XLFIPV VALIDATE]
N DIR,X,XLFX
S DIR(0)="F^3:60",DIR("A")="Enter an IP address to be validated",DIR("B")="127.0.0.1"
S DIR("?")=" Validate the format of an IP address."
S DIR("??")="^D VALH^XLFIPV"
D ^DIR S XLFX=$$VALIDATE(X)
I XLFX=0 W !!,?3,X," is NOT a valid address."
I XLFX=1 W !!,?3,X," is a valid address."
Q
;
VALH ; Extended help for VAL^XLFIPV
W !!," This option will validate the format of an IP address (either IPv4 or IPv6)"
W !," and return ""IP is NOT a valid address"" if the address is in an invalid"
W !," format, or return ""IP is a valid address"" if the format is correct."
Q
;
IP4 ; OPTION. "Convert any IP address to IPv4" [XLFIPV FORCEIP4]
N DIR,X
S DIR(0)="F^3:60",DIR("A")="Enter an IP address to be converted to IPv4",DIR("B")="127.0.0.1"
S DIR("?")=" Convert an IP address into an IPv4 address in a standardized format."
S DIR("??")="^D IP4H^XLFIPV"
D ^DIR W !!,?3,$$FORCEIP4(X)
Q
;
IP4H ; Extended help for IP4^XLFIPV
W !!," This option will take an IP address (either IPv4 or IPv6) and return an"
W !," IPv4 address in a standardized format. It will return the null address"
W !," 0.0.0.0 if the passed IP address is invalid. If an IPv6 address is input"
W !," which does not have a valid IPv4 equivalent, the null address will be"
W !," returned."
Q
;
IP6 ; OPTION. "Convert any IP address to IPv6" [XLFIPV FORCEIP6]
N DIR,X
S DIR(0)="F^3:60",DIR("A")="Enter an IP address to be converted to IPv6",DIR("B")="127.0.0.1"
S DIR("?")=" Convert an IP address into an IPv6 address in a standardized format."
S DIR("??")="^D IP6H^XLFIPV"
D ^DIR W !!,?3,$$FORCEIP6(X)
Q
IP6H ; Extended help for IP6^XLFIPV
W !!," This option will take an IP address (either IPv4 or IPv6) and return an"
W !," IPv6 address in a standardized format. It will return the null address"
W !," ::0 if the passed IP address is invalid."
Q
;
CON ; OPTION. "Convert any IP address per system settings" [XLFIPV CONVERT]
N DIR,X
S DIR(0)="F^3:60",DIR("A")="Enter an IP address to be converted",DIR("B")="127.0.0.1"
S DIR("?")=" Convert an IP address depending upon system settings."
S DIR("??")="^D CONH^XLFIPV"
D ^DIR W !!,?3,$$CONVERT(X)
Q
CONH ; Extended help for CON^XLFIPV
W !!," This option will take an IP address (either IPv4 or IPv6) and return an"
W !," IP address in a standardized format, depending on system settings. If"
W !," IPv6 is disabled on the system, an IPv4 address will be returned. If"
W !," IPv6 is enabled on the system, an IPv6 address will be returned. If an"
W !," invalid address is entered, a null address will be returned. If an IPv6"
W !," is entered, IPv6 is not enabled, and the input address does not have an"
W !," IPv4 equivalent, a null address will be returned."
Q
;
VER ; OPTION. "Show system settings for IPv6" [XLFIPV VERSION]
N X,XLSYS,XLVER
S X=$$VERSION,XLSYS=$$VERSION^%ZOSV(1),XLVER=+$$VERSION^%ZOSV()
W !!,?3,XLSYS," ",XLVER
I X=0 D Q
. I (XLSYS["Cache")!(XLSYS["IRIS") D Q
. . I XLVER>2009 W !!," IPv6 is available but is disabled on this system." Q
. . W !!," IPv6 is not available on this version of Cache."
. W !!," IPv6 is not available on this system."
I X=1 W !!," IPv6 is enabled on this system."
Q
;
EXPAND4(IP) ; INTRINSIC.
; Changes the format of an IPv4 address to a common format that can be validated
; Usage: S Y=$$EXPAND4^XLFIPV(IP)
; Input: IP (string) IPv4 address to be reformatted.
; Output: returns: An IPv4 address in the format "nnn.nnn.nnn.nnn".
;
N I,XLFIELD
; Expand hexadecimal address to IPv4 dotted hexadecimal: "0xc0a8010a" -> "0xc0.0xa8.0x10.0x0a"
I ($E(IP,1,2)="0x")&(IP'[".") D
. S IP="0x"_$E(IP,3,4)_".0x"_$E(IP,5,6)_".0x"_$E(IP,7,8)_".0x"_$E(IP,9,10)
F I=1:1:4 D ; Examine field by field
. S XLFIELD=$P(IP,".",I)
. ; Convert dotted hexadecimal address to IPv4 dotted decimal: "0xc0.0xa8.0x10.0x0a" -> "192.168.16.10"
. I $E(XLFIELD,1,2)="0x" S XLFIELD=$$DEC^XLFUTL($$UP^XLFSTR($E(XLFIELD,3,4)),16) ; Convert HEX field to DEC
. S $P(IP,".",I)=XLFIELD
; Convert dotted octal address to IPv4 dotted decimal: "0300.0000.0002.0353" -> "192.0.2.235"
I IP?4N1"."4N1"."4N1"."4N D
. S IP=$$DEC^XLFUTL($E(IP,1,4),8)_"."_$$DEC^XLFUTL($E(IP,6,9),8)_"."_$$DEC^XLFUTL($E(IP,11,14),8)_"."_$$DEC^XLFUTL($E(IP,16,19),8)
Q IP
;
EXPAND6(IP,ZNUM) ; INTRINSIC.
; Changes the format of an IPv6 address to a common format that can be validated
; Usage: S Y=$$EXPAND6^XLFIPV(IP)
; Input: IP (string) IPv6 address to be reformatted.
; ZNUM The number of expected colons
; Output: returns: An IPv6 address in the format "hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh".
;
N I,XLBLANK,XLCNT,XLFIELD
S IP=$P($G(IP),"%") ;p638 Remove routing information
I IP[":::" S IP="" Q IP ; Cannot contain :::
I $E(IP,1)="[" S IP=$P($P(IP,"[",2),"]") ; Strip brackets [] from around an address string
S XLCNT=ZNUM-($L(IP)-$L($TR(IP,":",""))) ; Count the number of colons needed to be added in short form address
I (XLCNT>0)&(IP'["::") S IP="" Q IP ; If missing a colon, but no "::", then return "" for invalid address
I XLCNT>0 S XLBLANK="" S IP=$P(IP,"::",1)_$TR($JUSTIFY(XLBLANK,XLCNT+2)," ",":")_$P(IP,"::",2) ; Expand ::
F I=1:1:(ZNUM+1) D ; Examine field by field
. S XLFIELD=$$UP^XLFSTR($P(IP,":",I))
. S XLFIELD=$TR($JUSTIFY(XLFIELD,4)," ","0") ; Add leading zeros
. S $P(IP,":",I)=XLFIELD
Q IP
;
EXAMINE4(XLFIELD) ; INTRINSIC.
; Examine a single field of an IPv4 address for a valid format
; Usage: S Y=$$EXAMINE4^XLFIPV(XLFIELD)
; Input: XLFIELD (string) Field to be examined.
; Output: returns:
; 1 - if the field is valid.
; 0 - if the field is invalid.
;
I XLFIELD'?1.3N Q 0 ; Test format NNN
I (XLFIELD>255)!(XLFIELD<0) Q 0 ; Test address range
Q 1
;
EXAMINE6(XLFIELD) ; INTRINSIC.
; Examine a single field of an IPv6 address for a valid format
; Usage: S Y=$$EXAMINE6^XLFIPV(XLFIELD)
; Input: XLFIELD (string) Field to be examined.
; Output: returns:
; 1 - if the field is valid.
; 0 - if the field is invalid.
;
N I,X
S XLFIELD=$$UP^XLFSTR(XLFIELD) I XLFIELD'?4E Q 0 ; Test format EEEE
S X=1 F I=1:1:4 D
. I "0123456789ABCDEF"'[$E(XLFIELD,I) S X=0 ; Test address range, contains 0 through F characters only
Q X
;
CNVF(IP) ; INTRINSIC.
; Expands a decimal IP address "ddd.ddd.ddd.ddd" to hexadecimal fields
; Usage: S Y=$$CNVF^XLFIPV(IP)
; Input: IP (string) IPv4 address to be reformatted.
; Output: returns: The last two bytes of an IPv6 address in the format "hhhh:hhhh".
;
N I,XLFIELD,XLOUT
S XLOUT=""
F I=1:1:4 D ; Examine field by field
. S XLFIELD=$$CNV^XLFUTL($P(IP,".",I),16)
. S XLOUT=XLOUT_$TR($JUSTIFY(XLFIELD,2)," ","0") ; Add leading zeros
. I I=2 S XLOUT=XLOUT_":"
Q XLOUT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HXLFIPV 13169 printed Apr 09, 2024@21:16:33 Page 2
XLFIPV ;ISD/HGW - IPv4 and IPv6 Utilities ; 8/19/20 10:57am
+1 ;;8.0;KERNEL;**605,638,736**;Aug 6, 2012;Build 12
+2 ;Per VA Directive 6402, this routine should not be modified.
+3 QUIT
+4 ;
VALIDATE(IP) ; EXTRINSIC. ICR #5844 (supported)
+1 ; Validate the format of an IP address (either IPv4 or IPv6).
+2 ; Usage: S Y=$$VALIDATE^XLFIPV(IP)
+3 ; Input: IP (string) - IPv4 or IPv6 Address to be validated.
+4 ; Output: returns:
+5 ; 1 - if the IP address is in a valid format.
+6 ; 0 - if the format is invalid or null input.
+7 ;
+8 NEW I,J,X,XLFIELD
+9 SET X=1
+10 IF '$DATA(IP)
QUIT 0
+11 ;p638 Strip off port information from IPv4 address
IF IP?1.3N1P1.3N1P1.3N1P1.3N1P.N
SET IP=$PIECE(IP,":",1)
+12 ; If IP address contains both ":" and "." delimiters, then check IPv4 embedded in IPv6.
+13 ; IPv4-Mapped.
IF (IP[":")&(IP[".")
Begin DoDot:1
+14 ; Change the format of the first six high-order bytes
SET IP=$$EXPAND6(IP,6)
IF IP=""
SET X=0
QUIT
+15 ; Examine field by field, first six bytes
FOR I=1:1:6
if X=0
QUIT
Begin DoDot:2
+16 SET X=$$EXAMINE6($PIECE(IP,":",I))
End DoDot:2
+17 ; Get last two bytes, IPv4 format
SET XLFIELD=$PIECE(IP,":",7)
+18 ; Examine field by field, last two bytes
FOR I=1:1:4
if X=0
QUIT
Begin DoDot:2
+19 SET X=$$EXAMINE4($PIECE(XLFIELD,".",I))
End DoDot:2
End DoDot:1
QUIT X
+20 ; If IP address contains ":" delimiter, then IPv6. Otherwise IPv4.
+21 ; IPv6 address
IF IP[":"
Begin DoDot:1
+22 ; Change to a common format
SET IP=$$EXPAND6(IP,7)
IF IP=""
SET X=0
QUIT
+23 ; Examine field by field
FOR I=1:1:8
if X=0
QUIT
Begin DoDot:2
+24 SET X=$$EXAMINE6($PIECE(IP,":",I))
End DoDot:2
End DoDot:1
QUIT X
+25 ; IPv4 address
IF IP'[":"
Begin DoDot:1
+26 ; Change to a common format
SET IP=$$EXPAND4(IP)
+27 ; Examine field by field
FOR I=1:1:4
if X=0
QUIT
Begin DoDot:2
+28 SET X=$$EXAMINE4($PIECE(IP,".",I))
End DoDot:2
End DoDot:1
QUIT X
+29 QUIT 0
+30 ;
FORCEIP4(IP) ; EXTRINSIC. ICR #5844 (supported)
+1 ; Convert an IP address (either IPv4 or IPv6) into an IPv4 address in a standardized format: "127.0.0.1".
+2 ; Usage: S Y=$$FORCEIP4^XLFIPV(IP)
+3 ; Input: IP (string) IPv4 or IPv6 Address to be converted.
+4 ; Output: returns: An IPv4 address in "ddd.ddd.ddd.ddd" notation if the input address is valid and has an
+5 ; IPv4 equivalent, or the null address "0.0.0.0" if the input address is invalid, or the null address
+6 ; "0.0.0.0" if an IPv6 address is input which does not have an IPv4 equivalent.
+7 ;
+8 NEW I,XLFIELD,XLMAP
+9 ; Return null address "0.0.0.0" if address is invalid
+10 if '$$VALIDATE(IP)
QUIT "0.0.0.0"
+11 ;p638 Strip off port information from IPv4 address
IF IP?1.3N1P1.3N1P1.3N1P1.3N1P.N
SET IP=$PIECE(IP,":")
+12 SET XLMAP="0000:0000:0000:0000:0000:FFFF:"
+13 ; If IP address contains both ":" and "." delimiters, then IPv4-Mapped IPv6 address.
+14 ; IPv4-Mapped.
IF (IP[":")&(IP[".")
Begin DoDot:1
+15 ; Change the format of the first six high-order bytes
SET IP=$$EXPAND6(IP,6)
IF IP=""
SET IP="0.0.0.0"
QUIT
+16 ; Get last two bytes, IPv4 format (not interested in first six bytes)
SET IP=$$EXPAND4($EXTRACT(IP,31,49))
End DoDot:1
QUIT IP
+17 ; IPv6 address (last two bytes might be IPv4-Mapped)
IF IP[":"
Begin DoDot:1
+18 ; Change the format to standardized
SET IP=$$EXPAND6(IP,7)
IF IP=""
SET IP="0.0.0.0"
QUIT
+19 ; Loopback address
IF IP="0000:0000:0000:0000:0000:0000:0000:0001"
SET IP="127.0.0.1"
QUIT
+20 ; Invalid IPv4-Mapped address
IF $EXTRACT(IP,1,30)'=XLMAP
SET IP="0.0.0.0"
QUIT
+21 SET IP=$$DEC^XLFUTL($EXTRACT(IP,31,32),16)_"."_$$DEC^XLFUTL($EXTRACT(IP,33,34),16)_"."_$$DEC^XLFUTL($EXTRACT(IP,36,37),16)_"."_$$DEC^XLFUTL($EXTRACT(IP,38,39),16)
End DoDot:1
QUIT IP
+22 ; IPv4 address
IF IP'[":"
Begin DoDot:1
+23 ; Change to a common format
SET IP=$$EXPAND4(IP)
End DoDot:1
QUIT IP
+24 QUIT "0.0.0.0"
+25 ;
FORCEIP6(IP) ; EXTRINSIC. ICR #5844 (supported)
+1 ; Convert an IP address (either IPv4 or IPv6) into an IPv6 address in a standardized format: "2001:0DB8:0000:0000:0000:8A2E:0370:7334".
+2 ; Usage: S Y=$$FORCEIP6^XLFIPV(IP)
+3 ; Input: IP (string) IPv4 or IPv6 Address to be converted.
+4 ; Output: returns: An IPv6 address in "hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh" notation if the
+5 ; input address is valid, or the null address "::0" if the input address is invalid.
+6 ;
+7 NEW XLMAP
+8 ; Return expanded null address "0000:0000:0000:0000:0000:0000:0000:0000" if address is invalid
+9 if '$$VALIDATE(IP)
QUIT "0000:0000:0000:0000:0000:0000:0000:0000"
+10 SET XLMAP="0000:0000:0000:0000:0000:FFFF:"
+11 ;p638 Strip off port information from IPv4 address
IF IP?1.3N1P1.3N1P1.3N1P1.3N1P.N
SET IP=$PIECE(IP,":")
+12 ; If IP address contains both ":" and "." delimiters, then IPv4 embedded in IPv6.
+13 ; IPv4-Mapped address.
IF (IP[":")&(IP[".")
Begin DoDot:1
+14 ; Change the format of the first six high-order bytes
SET IP=$$EXPAND6(IP,6)
IF IP=""
SET IP="0.0.0.0"
QUIT
+15 ; Get last two bytes, IPv4 format -> IPv4-Mapped Address
SET IP=$EXTRACT(IP,1,30)_$$CNVF($$EXPAND4($EXTRACT(IP,31,49)))
End DoDot:1
QUIT IP
+16 ; If IP address contains ":" delimiter, then IPv6. Otherwise IPv4.
+17 ; IPv6 address
IF IP[":"
Begin DoDot:1
+18 ; Change to a common format
SET IP=$$EXPAND6(IP,7)
IF IP=""
SET IP="0000:0000:0000:0000:0000:0000:0000:0000"
QUIT
End DoDot:1
QUIT IP
+19 ; IPv4 address
IF IP'[":"
Begin DoDot:1
+20 ; IPv4-Mapped IPv6 Address
SET IP=XLMAP_$$CNVF($$EXPAND4(IP))
+21 ; Null address
IF IP="0000:0000:0000:0000:0000:FFFF:0000:0000"
SET IP="0000:0000:0000:0000:0000:0000:0000:0000"
QUIT
+22 ; Loopback address
IF IP="0000:0000:0000:0000:0000:FFFF:7F00:0001"
SET IP="0000:0000:0000:0000:0000:0000:0000:0001"
QUIT
End DoDot:1
QUIT IP
+23 QUIT IP
+24 ;
CONVERT(IP) ; EXTRINSIC. ICR #5844 (supported)
+1 ; Convert an IP address (either IPv4 or IPv6) into an IPv6 address in a standardized format, either IPv4 or IPv6 depending
+2 ; upon the Cache system settings.
+3 ; Usage: S Y=$$CONVERT^XLFIPV(IP)
+4 ; Input: IP (string) IPv4 or IPv6 Address to be converted.
+5 ; Output: returns:
+6 ; - An IPv4 address if IPv6 is disabled on the system.
+7 ; - An IPv6 address if IPv6 is enabled on the system.
+8 ; - An IPv4 or IPv6 null address if the input cannot be converted.
+9 ;
+10 NEW XLV6
+11 ; Is IPv6 enabled on this system?
SET XLV6=$$VERSION()
+12 ; Yes
IF XLV6=1
SET IP=$$FORCEIP6(IP)
+13 ; No
IF XLV6=0
SET IP=$$FORCEIP4(IP)
+14 QUIT IP
+15 ;
VERSION() ; EXTRINSIC. ICR #5844 (supported)
+1 ; Determine the Cache system settings for IPv6.
+2 ; Usage: S Y=$$VERSION^XLFIPV()
+3 ; Input: None.
+4 ; Output: returns:
+5 ; 1 - if IPv6 is enabled.
+6 ; 0 - if IPv6 is disabled.
+7 ;
+8 NEW %
+9 SET %=0
+10 IF ($$VERSION^%ZOSV(1)["Cache")!($$VERSION^%ZOSV(1)["IRIS")
IF +$$VERSION^%ZOSV()>2009
SET %=$SYSTEM.Process.IPv6Format()
+11 QUIT %
+12 ;
VAL ; OPTION. "Validate IPv4 and IPv6 address" [XLFIPV VALIDATE]
+1 NEW DIR,X,XLFX
+2 SET DIR(0)="F^3:60"
SET DIR("A")="Enter an IP address to be validated"
SET DIR("B")="127.0.0.1"
+3 SET DIR("?")=" Validate the format of an IP address."
+4 SET DIR("??")="^D VALH^XLFIPV"
+5 DO ^DIR
SET XLFX=$$VALIDATE(X)
+6 IF XLFX=0
WRITE !!,?3,X," is NOT a valid address."
+7 IF XLFX=1
WRITE !!,?3,X," is a valid address."
+8 QUIT
+9 ;
VALH ; Extended help for VAL^XLFIPV
+1 WRITE !!," This option will validate the format of an IP address (either IPv4 or IPv6)"
+2 WRITE !," and return ""IP is NOT a valid address"" if the address is in an invalid"
+3 WRITE !," format, or return ""IP is a valid address"" if the format is correct."
+4 QUIT
+5 ;
IP4 ; OPTION. "Convert any IP address to IPv4" [XLFIPV FORCEIP4]
+1 NEW DIR,X
+2 SET DIR(0)="F^3:60"
SET DIR("A")="Enter an IP address to be converted to IPv4"
SET DIR("B")="127.0.0.1"
+3 SET DIR("?")=" Convert an IP address into an IPv4 address in a standardized format."
+4 SET DIR("??")="^D IP4H^XLFIPV"
+5 DO ^DIR
WRITE !!,?3,$$FORCEIP4(X)
+6 QUIT
+7 ;
IP4H ; Extended help for IP4^XLFIPV
+1 WRITE !!," This option will take an IP address (either IPv4 or IPv6) and return an"
+2 WRITE !," IPv4 address in a standardized format. It will return the null address"
+3 WRITE !," 0.0.0.0 if the passed IP address is invalid. If an IPv6 address is input"
+4 WRITE !," which does not have a valid IPv4 equivalent, the null address will be"
+5 WRITE !," returned."
+6 QUIT
+7 ;
IP6 ; OPTION. "Convert any IP address to IPv6" [XLFIPV FORCEIP6]
+1 NEW DIR,X
+2 SET DIR(0)="F^3:60"
SET DIR("A")="Enter an IP address to be converted to IPv6"
SET DIR("B")="127.0.0.1"
+3 SET DIR("?")=" Convert an IP address into an IPv6 address in a standardized format."
+4 SET DIR("??")="^D IP6H^XLFIPV"
+5 DO ^DIR
WRITE !!,?3,$$FORCEIP6(X)
+6 QUIT
IP6H ; Extended help for IP6^XLFIPV
+1 WRITE !!," This option will take an IP address (either IPv4 or IPv6) and return an"
+2 WRITE !," IPv6 address in a standardized format. It will return the null address"
+3 WRITE !," ::0 if the passed IP address is invalid."
+4 QUIT
+5 ;
CON ; OPTION. "Convert any IP address per system settings" [XLFIPV CONVERT]
+1 NEW DIR,X
+2 SET DIR(0)="F^3:60"
SET DIR("A")="Enter an IP address to be converted"
SET DIR("B")="127.0.0.1"
+3 SET DIR("?")=" Convert an IP address depending upon system settings."
+4 SET DIR("??")="^D CONH^XLFIPV"
+5 DO ^DIR
WRITE !!,?3,$$CONVERT(X)
+6 QUIT
CONH ; Extended help for CON^XLFIPV
+1 WRITE !!," This option will take an IP address (either IPv4 or IPv6) and return an"
+2 WRITE !," IP address in a standardized format, depending on system settings. If"
+3 WRITE !," IPv6 is disabled on the system, an IPv4 address will be returned. If"
+4 WRITE !," IPv6 is enabled on the system, an IPv6 address will be returned. If an"
+5 WRITE !," invalid address is entered, a null address will be returned. If an IPv6"
+6 WRITE !," is entered, IPv6 is not enabled, and the input address does not have an"
+7 WRITE !," IPv4 equivalent, a null address will be returned."
+8 QUIT
+9 ;
VER ; OPTION. "Show system settings for IPv6" [XLFIPV VERSION]
+1 NEW X,XLSYS,XLVER
+2 SET X=$$VERSION
SET XLSYS=$$VERSION^%ZOSV(1)
SET XLVER=+$$VERSION^%ZOSV()
+3 WRITE !!,?3,XLSYS," ",XLVER
+4 IF X=0
Begin DoDot:1
+5 IF (XLSYS["Cache")!(XLSYS["IRIS")
Begin DoDot:2
+6 IF XLVER>2009
WRITE !!," IPv6 is available but is disabled on this system."
QUIT
+7 WRITE !!," IPv6 is not available on this version of Cache."
End DoDot:2
QUIT
+8 WRITE !!," IPv6 is not available on this system."
End DoDot:1
QUIT
+9 IF X=1
WRITE !!," IPv6 is enabled on this system."
+10 QUIT
+11 ;
EXPAND4(IP) ; INTRINSIC.
+1 ; Changes the format of an IPv4 address to a common format that can be validated
+2 ; Usage: S Y=$$EXPAND4^XLFIPV(IP)
+3 ; Input: IP (string) IPv4 address to be reformatted.
+4 ; Output: returns: An IPv4 address in the format "nnn.nnn.nnn.nnn".
+5 ;
+6 NEW I,XLFIELD
+7 ; Expand hexadecimal address to IPv4 dotted hexadecimal: "0xc0a8010a" -> "0xc0.0xa8.0x10.0x0a"
+8 IF ($EXTRACT(IP,1,2)="0x")&(IP'[".")
Begin DoDot:1
+9 SET IP="0x"_$EXTRACT(IP,3,4)_".0x"_$EXTRACT(IP,5,6)_".0x"_$EXTRACT(IP,7,8)_".0x"_$EXTRACT(IP,9,10)
End DoDot:1
+10 ; Examine field by field
FOR I=1:1:4
Begin DoDot:1
+11 SET XLFIELD=$PIECE(IP,".",I)
+12 ; Convert dotted hexadecimal address to IPv4 dotted decimal: "0xc0.0xa8.0x10.0x0a" -> "192.168.16.10"
+13 ; Convert HEX field to DEC
IF $EXTRACT(XLFIELD,1,2)="0x"
SET XLFIELD=$$DEC^XLFUTL($$UP^XLFSTR($EXTRACT(XLFIELD,3,4)),16)
+14 SET $PIECE(IP,".",I)=XLFIELD
End DoDot:1
+15 ; Convert dotted octal address to IPv4 dotted decimal: "0300.0000.0002.0353" -> "192.0.2.235"
+16 IF IP?4N1"."4N1"."4N1"."4N
Begin DoDot:1
+17 SET IP=$$DEC^XLFUTL($EXTRACT(IP,1,4),8)_"."_$$DEC^XLFUTL($EXTRACT(IP,6,9),8)_"."_$$DEC^XLFUTL($EXTRACT(IP,11,14),8)_"."_$$DEC^XLFUTL($EXTRACT(IP,16,19),8)
End DoDot:1
+18 QUIT IP
+19 ;
EXPAND6(IP,ZNUM) ; INTRINSIC.
+1 ; Changes the format of an IPv6 address to a common format that can be validated
+2 ; Usage: S Y=$$EXPAND6^XLFIPV(IP)
+3 ; Input: IP (string) IPv6 address to be reformatted.
+4 ; ZNUM The number of expected colons
+5 ; Output: returns: An IPv6 address in the format "hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh:hhhh".
+6 ;
+7 NEW I,XLBLANK,XLCNT,XLFIELD
+8 ;p638 Remove routing information
SET IP=$PIECE($GET(IP),"%")
+9 ; Cannot contain :::
IF IP[":::"
SET IP=""
QUIT IP
+10 ; Strip brackets [] from around an address string
IF $EXTRACT(IP,1)="["
SET IP=$PIECE($PIECE(IP,"[",2),"]")
+11 ; Count the number of colons needed to be added in short form address
SET XLCNT=ZNUM-($LENGTH(IP)-$LENGTH($TRANSLATE(IP,":","")))
+12 ; If missing a colon, but no "::", then return "" for invalid address
IF (XLCNT>0)&(IP'["::")
SET IP=""
QUIT IP
+13 ; Expand ::
IF XLCNT>0
SET XLBLANK=""
SET IP=$PIECE(IP,"::",1)_$TRANSLATE($JUSTIFY(XLBLANK,XLCNT+2)," ",":")_$PIECE(IP,"::",2)
+14 ; Examine field by field
FOR I=1:1:(ZNUM+1)
Begin DoDot:1
+15 SET XLFIELD=$$UP^XLFSTR($PIECE(IP,":",I))
+16 ; Add leading zeros
SET XLFIELD=$TRANSLATE($JUSTIFY(XLFIELD,4)," ","0")
+17 SET $PIECE(IP,":",I)=XLFIELD
End DoDot:1
+18 QUIT IP
+19 ;
EXAMINE4(XLFIELD) ; INTRINSIC.
+1 ; Examine a single field of an IPv4 address for a valid format
+2 ; Usage: S Y=$$EXAMINE4^XLFIPV(XLFIELD)
+3 ; Input: XLFIELD (string) Field to be examined.
+4 ; Output: returns:
+5 ; 1 - if the field is valid.
+6 ; 0 - if the field is invalid.
+7 ;
+8 ; Test format NNN
IF XLFIELD'?1.3N
QUIT 0
+9 ; Test address range
IF (XLFIELD>255)!(XLFIELD<0)
QUIT 0
+10 QUIT 1
+11 ;
EXAMINE6(XLFIELD) ; INTRINSIC.
+1 ; Examine a single field of an IPv6 address for a valid format
+2 ; Usage: S Y=$$EXAMINE6^XLFIPV(XLFIELD)
+3 ; Input: XLFIELD (string) Field to be examined.
+4 ; Output: returns:
+5 ; 1 - if the field is valid.
+6 ; 0 - if the field is invalid.
+7 ;
+8 NEW I,X
+9 ; Test format EEEE
SET XLFIELD=$$UP^XLFSTR(XLFIELD)
IF XLFIELD'?4E
QUIT 0
+10 SET X=1
FOR I=1:1:4
Begin DoDot:1
+11 ; Test address range, contains 0 through F characters only
IF "0123456789ABCDEF"'[$EXTRACT(XLFIELD,I)
SET X=0
End DoDot:1
+12 QUIT X
+13 ;
CNVF(IP) ; INTRINSIC.
+1 ; Expands a decimal IP address "ddd.ddd.ddd.ddd" to hexadecimal fields
+2 ; Usage: S Y=$$CNVF^XLFIPV(IP)
+3 ; Input: IP (string) IPv4 address to be reformatted.
+4 ; Output: returns: The last two bytes of an IPv6 address in the format "hhhh:hhhh".
+5 ;
+6 NEW I,XLFIELD,XLOUT
+7 SET XLOUT=""
+8 ; Examine field by field
FOR I=1:1:4
Begin DoDot:1
+9 SET XLFIELD=$$CNV^XLFUTL($PIECE(IP,".",I),16)
+10 ; Add leading zeros
SET XLOUT=XLOUT_$TRANSLATE($JUSTIFY(XLFIELD,2)," ","0")
+11 IF I=2
SET XLOUT=XLOUT_":"
End DoDot:1
+12 QUIT XLOUT
+13 ;
