155 lines
3.0 KiB
Plaintext
155 lines
3.0 KiB
Plaintext
|
use re
|
||
|
use str
|
||
|
use ./common
|
||
|
use ./list
|
||
|
use ./num
|
||
|
|
||
|
fn is-ipv4 {|arg|
|
||
|
common:cexec ^
|
||
|
(re:match '^([0-9]{1,3}\.){3}[0-9]{1,3}$' $arg) ^
|
||
|
{ not (str:split '.' $arg | list:contains {|p| > $p 255 }) } ^
|
||
|
$false
|
||
|
}
|
||
|
|
||
|
fn is-ipv6 {|arg|
|
||
|
var p = '[0-9a-fA-F]{1,4}'
|
||
|
var g1 g2 = (printf '(%s:)' $p) (printf '(:%s)' $p)
|
||
|
var cases = [
|
||
|
(printf '%s{7,7}%s' $g1 $p)
|
||
|
(printf '%s{1,7}:' $g1)
|
||
|
(printf '%s{1,6}:%s' $g1 $p)
|
||
|
(printf '%s{1,5}%s{1,2}' $g1 $g2)
|
||
|
(printf '%s{1,4}%s{1,3}' $g1 $g2)
|
||
|
(printf '%s{1,3}%s{1,4}' $g1 $g2)
|
||
|
(printf '%s{1,2}%s{1,5}' $g1 $g2)
|
||
|
(printf '%s:%s{1,6}' $p $g2)
|
||
|
(printf ':%s{1,7}' $g2)
|
||
|
'::'
|
||
|
]
|
||
|
var r = (printf '^(%s)$' (str:join '|' $cases))
|
||
|
re:match $r $arg
|
||
|
}
|
||
|
|
||
|
fn is-ip {|arg|
|
||
|
or (is-ipv4 $arg) (is-ipv6 $arg)
|
||
|
}
|
||
|
|
||
|
fn -l6 {|p|
|
||
|
set p = (str:to-lower $p)
|
||
|
var c = (- 4 (count $p))
|
||
|
put (repeat $c '0') $p | str:join ''
|
||
|
}
|
||
|
|
||
|
fn -m6 {|p|
|
||
|
while (and (> (count $p) 1) (eq $p[0] 0)) {
|
||
|
set p = $p[1..]
|
||
|
}
|
||
|
put $p
|
||
|
}
|
||
|
|
||
|
fn -max0 {|parts|
|
||
|
var idx s = -1 1
|
||
|
var ci cs f = -1 0 $false
|
||
|
list:foreach {|i p|
|
||
|
if (eq $p 0) {
|
||
|
if $f {
|
||
|
set cs = (num:++ $cs)
|
||
|
} else {
|
||
|
set ci cs f = $i 1 $true
|
||
|
}
|
||
|
} elif $f {
|
||
|
set f = $false
|
||
|
if (> $cs $s) {
|
||
|
set idx s = $ci $cs
|
||
|
}
|
||
|
}
|
||
|
} $parts
|
||
|
if (and $f (> $cs $s)) {
|
||
|
set idx s = $ci $cs
|
||
|
}
|
||
|
put $idx $s
|
||
|
}
|
||
|
|
||
|
fn long6 {|ip|
|
||
|
if (not (is-ipv6 $ip)) {
|
||
|
fail 'Not an IPv6'
|
||
|
}
|
||
|
if (eq $ip '::') {
|
||
|
repeat 8 '0000' | str:join ':'
|
||
|
return
|
||
|
}
|
||
|
var c = (- 7 (str:count $ip ':'))
|
||
|
if (> $c 0) {
|
||
|
var i = (str:index $ip '::')
|
||
|
var z = (repeat $c ':' | str:join '')
|
||
|
set ip = (str:join '' [$ip[..$i] $z $ip[$i..]])
|
||
|
}
|
||
|
str:split ':' $ip | each $-l6~ | str:join ':'
|
||
|
}
|
||
|
|
||
|
fn middle6 {|ip|
|
||
|
str:split ':' (long6 $ip) | each $-m6~ | str:join ':'
|
||
|
}
|
||
|
|
||
|
fn short6 {|ip|
|
||
|
var parts = [(str:split ':' (middle6 $ip))]
|
||
|
var i s = (-max0 $parts)
|
||
|
if (>= $i 0) {
|
||
|
var left right = $parts[..$i] $parts[(+ $i $s)..]
|
||
|
if (== (count $left) 0) {
|
||
|
set left = ['']
|
||
|
}
|
||
|
if (== (count $right) 0) {
|
||
|
set right = ['']
|
||
|
}
|
||
|
set @parts = $@left '' $@right
|
||
|
}
|
||
|
str:join ':' $parts
|
||
|
}
|
||
|
|
||
|
fn -cmp {|e1 e2|
|
||
|
var c = 0
|
||
|
list:foreach {|i p1|
|
||
|
var p2 = $e2[$i]
|
||
|
set c = (compare $p1 $p2)
|
||
|
if (!= $c 0) {
|
||
|
break
|
||
|
}
|
||
|
} $e1
|
||
|
put $c
|
||
|
}
|
||
|
|
||
|
fn comp4 {|ip1 ip2|
|
||
|
if (or (not (is-ipv4 $ip1)) (not (is-ipv4 $ip2))) {
|
||
|
fail (printf 'Not an IPv4: %s → %s' $ip1 $ip2)
|
||
|
}
|
||
|
-cmp [(str:split . $ip1)] [(str:split . $ip2)]
|
||
|
}
|
||
|
|
||
|
fn comp6 {|ip1 ip2|
|
||
|
if (or (not (is-ipv6 $ip1)) (not (is-ipv6 $ip2))) {
|
||
|
fail (printf 'Not an IPv6: %s → %s' $ip1 $ip2)
|
||
|
}
|
||
|
-cmp [(str:split : (middle6 $ip1))] [(str:split : (middle6 $ip2))]
|
||
|
}
|
||
|
|
||
|
fn comp {|ip1 ip2|
|
||
|
if (is-ipv4 $ip1) {
|
||
|
if (is-ipv4 $ip2) {
|
||
|
comp4 $ip1 $ip2
|
||
|
} else {
|
||
|
put -1
|
||
|
}
|
||
|
} elif (is-ipv6 $ip1) {
|
||
|
if (is-ipv4 $ip2) {
|
||
|
put 1
|
||
|
} elif (is-ipv6 $ip2) {
|
||
|
comp6 $ip1 $ip2
|
||
|
} else {
|
||
|
put -1
|
||
|
}
|
||
|
} else {
|
||
|
fail (printf 'Not an IP: %s → %s' $ip1 $ip2)
|
||
|
}
|
||
|
}
|