1package STSupport; 2require Exporter; 3use File::Compare; 4 5@ISA = qw(Exporter); 6@EXPORT = qw( 7 DATADIR RND100 8 getArgString 9 startCategory endCategory startSubCategory endSubCategory addTestResult 10 runEmbExtCmp 11); 12 13# 14# set this to 1 if you want the test script to print verbose output 15# 16$Arg_Verbosity = 0 ; 17 18$curcategory = ""; 19$catstatus = 0 ; 20$cursubcategory = ""; 21$subcatstatus = 0 ; 22 23use constant DATADIR => "./data/" ; 24use constant RND100 => "rnd100" ; 25 26use constant TAB => " " ; 27use constant STEGHIDE => "../src/steghide" ; 28use constant DEFAULTSTGFN => "stgfile" ; 29use constant DEFAULTEXTFN => "extfile" ; 30use constant DEFEMBARGBASE => (command => "embed", f => "", "q" => "", p => "\"a passphrase\"", sf => DEFAULTSTGFN) ; 31use constant DEFEXTARGBASE => (command => "extract", f => "", "q" => "", p => "\"a passphrase\"", sf => DEFAULTSTGFN, xf => DEFAULTEXTFN) ; 32 33# 34# parse arguments for a st_*.pl script 35# 36sub parseArgs { 37 while (@_) { 38 $ARGV = shift @_ ; 39 if ($ARGV eq "-v" || $ARGV eq "--verbose") { 40 $Arg_Verbosity = 1 ; 41 } 42 } 43} 44 45# 46# create a string of arguments ready to be fed to steghide 47# expects a hash containing a "command" => "something" and argument/argument value pairs 48# 49sub getArgString { 50 my %args = @_ ; 51 52 $retval = $args{command} ; 53 delete $args{command} ; 54 55 foreach $arg (keys %args) { 56 $retval .= " -$arg $args{$arg}" ; 57 } 58 59 return $retval ; 60} 61 62# 63# start a category 64# first argument: category name, rest of list: arguments for execution of this category script 65# 66sub startCategory { 67 $curcategory = shift @_ ; 68 parseArgs (@_) ; 69 print "$curcategory:\n" ; 70 $catstatus = 1 ; 71} 72 73# 74# 75# return value: 1 if an error occured, 0 if everything was ok 76sub endCategory { 77 $curcategory = "" ; 78 print "\n" ; 79 if ($catstatus) { # no error 80 return 0 ; 81 } 82 else { # an error occured 83 return 1 ; 84 } 85} 86 87sub startSubCategory { 88 $cursubcategory = $_[0] ; 89 print TAB . $cursubcategory ; 90 $subcatstatus = 1 ; 91} 92 93sub endSubCategory { 94 $cursubcategory = "" ; 95 if ($subcatstatus) { 96 print "ok\n" ; 97 } 98 else { 99 print " !! FAILED !!\n" ; 100 } 101} 102 103sub addTestResult { 104 if ($_[0]) { 105 print "."; 106 } 107 else { 108 print "F"; 109 $subcatstatus = 0 ; 110 $catstatus = 0 ; 111 } 112} 113 114# 115# remove all files in the list passed to it 116sub remove { 117 while (@_) { 118 $f = shift @_ ; 119 system "rm -f $f" ; 120 } 121} 122 123# 124# run an embed-extract-compare test 125# expects 1-4 arguments: cvrfn, embfn, callerembargs, callerextargs 126sub runEmbExtCmp { 127 if ($Arg_Verbosity) { 128 print "\n\nrunning EmbExtCmp with...\n" ; 129 } 130 131 # evaluate arguments 132 $cvrfn = shift @_ ; 133 $embfn = DATADIR . RND100 ; # default 134 if (@_) { $embfn = shift @_ ; } 135 %callerembargs = () ; 136 if (@_) { 137 $ref = shift @_ ; 138 %callerembargs = %$ref ; 139 } 140 %callerextargs = () ; 141 if (@_) { 142 $ref = shift @_ ; 143 %callerextargs = %$ref ; 144 } 145 146 # prepare embedding 147 %embargs = ( 148 DEFEMBARGBASE, 149 cf => $cvrfn, 150 ef => $embfn, 151 %callerembargs 152 ) ; 153 $embcommand = STEGHIDE . " " . getArgString(%embargs) ; 154 155 # prepare extracting 156 %extargs = ( 157 DEFEXTARGBASE, 158 %callerextargs 159 ) ; 160 $extcommand = STEGHIDE . " " . getArgString(%extargs) ; 161 162 if ($Arg_Verbosity) { 163 print "embcommand: $embcommand\n" ; 164 print "extcommand: $extcommand\n" ; 165 } 166 167 # execute commands 168 `$embcommand 2>&1` ; # don't let it print to stderr or stdout 169 return 0 if $? ; 170 `$extcommand 2>&1` ; # don't let it print to stderr or stdout 171 return 0 if $? ; 172 173 # compare embfile and extfile 174 $filesequal = not compare ($embargs{ef}, $extargs{xf}) ; 175 remove ($embargs{sf}, $extargs{xf}) ; 176 177 return $filesequal ; 178} 179 1801; 181