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

XLFIPV.m

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