source: tests/webinject/webinject.pl @ a9c55d3

perl-5.22
Last change on this file since a9c55d3 was c5c522c, checked in by Edwin Eefting <edwin@datux.nl>, 8 years ago

initial commit, transferred from cleaned syn3 svn tree
  • Property mode set to 100755
File size: 61.8 KB
Line 
1#!/usr/bin/perl -w
2
3#    Copyright 2004-2006 Corey Goldberg (corey@goldb.org)
4#
5#    This file is part of WebInject.
6#
7#    WebInject is free software; you can redistribute it and/or modify
8#    it under the terms of the GNU General Public License as published by
9#    the Free Software Foundation; either version 2 of the License, or
10#    (at your option) any later version.
11#
12#    WebInject is distributed in the hope that it will be useful,
13#    but without any warranty; without even the implied warranty of
14#    merchantability or fitness for a particular purpose.  See the
15#    GNU General Public License for more details.
16
17
18our $version="1.41";
19
20use strict;
21use Net::SSL;
22
23use LWP;
24use HTTP::Request::Common;
25use HTTP::Cookies;
26use XML::Simple;
27use Time::HiRes 'time','sleep';
28use Getopt::Long;
29use Crypt::SSLeay;  #for SSL/HTTPS (you may comment this out if you don't need it)
30use XML::Parser;  #for web services verification (you may comment this out if aren't doing XML verifications for web services)
31use Error qw(:try);  #for web services verification (you may comment this out if aren't doing XML verifications for web services)
32#use Data::Dumper;  #uncomment to dump hashes for debugging   
33
34
35$| = 1; #don't buffer output to STDOUT
36
37
38our ($timestamp, $dirname);
39our (%parsedresult);
40our ($useragent, $request, $response);
41our ($gui, $monitorenabledchkbx, $latency);
42our ($cookie_jar, @httpauth);
43our ($xnode, $graphtype, $plotclear, $stop, $nooutput);
44our ($runcount, $totalruncount, $casepassedcount, $casefailedcount, $passedcount, $failedcount);
45our ($totalresponse, $avgresponse, $maxresponse, $minresponse);
46our (@casefilelist, $currentcasefile, $casecount, $isfailure);
47our (%case, $verifylater, $verifylaterneg);
48our (%config);
49our ($currentdatetime, $totalruntime, $starttimer, $endtimer);
50our ($opt_configfile, $opt_version, $opt_output);
51our ($reporttype, $returnmessage, %exit_codes);
52
53
54if (($0 =~ /webinject.pl/) or ($0 =~ /webinject.exe/)) {  #set flag so we know if it is running standalone or from webinjectgui
55    $gui = 0;
56    engine();
57}
58else {
59    $gui = 1;
60    getdirname();  #get the directory webinject engine is running from
61    whackoldfiles(); #delete files leftover from previous run (do this here so they are whacked on startup when running from gui)
62}
63
64
65
66#------------------------------------------------------------------
67sub engine {   #wrap the whole engine in a subroutine so it can be integrated with the gui
68     
69    our ($startruntimer, $endruntimer, $repeat);
70    our ($curgraphtype);
71    our ($casefilecheck, $testnum, $xmltestcases);
72
73    # undef local values
74    map { $case{$_} = undef } qw/method description1 description2 sleep/;
75       
76    if ($gui == 1) { gui_initial(); }
77       
78    getdirname();  #get the directory webinject engine is running from
79       
80    getoptions();  #get command line options
81       
82    whackoldfiles();  #delete files leftover from previous run (do this here so they are whacked each run)
83       
84    #contsruct objects
85    $useragent = LWP::UserAgent->new;
86    $cookie_jar = HTTP::Cookies->new;
87    $useragent->agent('WebInject');  #http useragent that will show up in webserver logs
88    $useragent->max_redirect('0');  #don't follow redirects for GET's (POST's already don't follow, by default)
89       
90       
91    if ($gui != 1){   
92        $graphtype = 'lines'; #default to line graph if not in GUI
93        $config{standaloneplot} = 'off'; #initialize so we don't get warnings when <standaloneplot> is not set in config         
94    }
95       
96    processcasefile();
97       
98    #add proxy support if it is set in config.xml
99    if ($config{proxy}) {
100        $useragent->proxy(['http', 'https'], "$config{proxy}")
101    }
102       
103    #add http basic authentication support
104    #corresponds to:
105    #$useragent->credentials('servername:portnumber', 'realm-name', 'username' => 'password');
106    if (@httpauth) {
107        #add the credentials to the user agent here. The foreach gives the reference to the tuple ($elem), and we
108        #deref $elem to get the array elements. 
109        my $elem;
110        foreach $elem(@httpauth) {
111            #print "adding credential: $elem->[0]:$elem->[1], $elem->[2], $elem->[3] => $elem->[4]\n";
112            $useragent->credentials("$elem->[0]:$elem->[1]", "$elem->[2]", "$elem->[3]" => "$elem->[4]");
113        }
114    }
115       
116    #change response delay timeout in seconds if it is set in config.xml     
117    if ($config{timeout}) {
118        $useragent->timeout("$config{timeout}");  #default LWP timeout is 180 secs.
119    }
120       
121    #open file handles
122    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
123        if ($opt_output) {  #use output location if it is passed from the command line
124            open(HTTPLOGFILE, ">$opt_output"."http.log") or die "\nERROR: Failed to open http.log file\n\n";   
125            open(RESULTS, ">$opt_output"."results.html") or die "\nERROR: Failed to open results.html file\n\n";   
126            open(RESULTSXML, ">$opt_output"."results.xml") or die "\nERROR: Failed to open results.xml file\n\n";
127        }
128        else {
129            open(HTTPLOGFILE, ">$dirname"."http.log") or die "\nERROR: Failed to open http.log file\n\n";   
130            open(RESULTS, ">$dirname"."results.html") or die "\nERROR: Failed to open results.html file\n\n";   
131            open(RESULTSXML, ">$dirname"."results.xml") or die "\nERROR: Failed to open results.xml file\n\n";
132        }
133    }
134       
135    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
136        print RESULTSXML qq|<results>\n\n|;  #write initial xml tag
137        writeinitialhtml();  #write opening tags for results file
138    }
139               
140    unless ($xnode or $nooutput) { #skip regular STDOUT output if using an XPath or $nooutput is set
141        writeinitialstdout();  #write opening tags for STDOUT.
142    }
143       
144    if ($gui == 1){ $curgraphtype = $graphtype; }  #set the initial value so we know if the user changes the graph setting from the gui
145       
146    gnuplotcfg(); #create the gnuplot config file
147       
148       
149    $totalruncount = 0;
150    $casepassedcount = 0;
151    $casefailedcount = 0;
152    $passedcount = 0;
153    $failedcount = 0;
154    $totalresponse = 0;
155    $avgresponse = 0;
156    $maxresponse = 0;
157    $minresponse = 10000000; #set to large value so first minresponse will be less
158    $stop = 'no';
159    $plotclear = 'no';
160       
161       
162    $currentdatetime = localtime time;  #get current date and time for results report
163    $startruntimer = time();  #timer for entire test run
164       
165       
166    foreach (@casefilelist) { #process test case files named in config
167       
168        $currentcasefile = $_;
169        #print "\n$currentcasefile\n\n";
170           
171        $casefilecheck = ' ';
172           
173        if ($gui == 1){ gui_processing_msg(); }
174           
175        convtestcases();
176           
177        fixsinglecase();
178         
179        $xmltestcases = XMLin("$dirname"."$currentcasefile".".$$".".tmp", VarAttr => 'varname'); #slurp test case file to parse (and specify variables tag)
180        #print Dumper($xmltestcases);  #for debug, dump hash of xml   
181        #print keys %{$configfile};  #for debug, print keys from dereferenced hash
182           
183        #delete the temp file as soon as we are done reading it   
184        if (-e "$dirname"."$currentcasefile".".$$".".tmp") { unlink "$dirname"."$currentcasefile".".$$".".tmp"; }       
185           
186           
187        $repeat = $xmltestcases->{repeat};  #grab the number of times to iterate test case file
188        unless ($repeat) { $repeat = 1; }  #set to 1 in case it is not defined in test case file               
189           
190           
191        foreach (1 .. $repeat) {
192               
193            $runcount = 0;
194               
195            foreach (sort {$a<=>$b} keys %{$xmltestcases->{case}}) {  #process cases in sorted order
196                   
197                $testnum = $_;
198                   
199                if ($xnode) {  #if an XPath Node is defined, only process the single Node
200                    $testnum = $xnode;
201                }
202                 
203                $isfailure = 0;
204                   
205                if ($gui == 1){
206                    unless ($monitorenabledchkbx eq 'monitor_off') {  #don't do this if monitor is disabled in gui
207                        if ("$curgraphtype" ne "$graphtype") {  #check to see if the user changed the graph setting
208                            gnuplotcfg();  #create the gnuplot config file since graph setting changed
209                            $curgraphtype = $graphtype;
210                        }
211                    }
212                }
213                   
214                $timestamp = time();  #used to replace parsed {timestamp} with real timestamp value
215                   
216                if ($case{verifypositivenext}) { $verifylater = $case{verifypositivenext}; }  #grab $case{verifypositivenext} string from previous test case (if it exists)
217                if ($case{verifynegativenext}) { $verifylaterneg = $case{verifynegativenext}; }  #grab $case{verifynegativenext} string from previous test case (if it exists)
218                   
219                # populate variables with values from testcase file, do substitutions, and revert converted values back
220                for (qw/method description1 description2 url postbody posttype addheader
221                        verifypositive verifypositive1 verifypositive2 verifypositive3
222                        verifynegative verifynegative1 verifynegative2 verifynegative3
223                        parseresponse parseresponse1 parseresponse2 parseresponse3 parseresponse4 parseresponse5
224                        verifyresponsecode logrequest logresponse sleep errormessage
225                        verifypositivenext verifynegativenext/) {
226                  $case{$_} = $xmltestcases->{case}->{$testnum}->{$_};
227                  if ($case{$_}) { convertbackxml($case{$_}); }
228                }
229
230                if ($gui == 1){ gui_tc_descript(); }
231
232                if ($case{description1} and $case{description1} =~ /dummy test case/) {  #if we hit a dummy record, skip it
233                    next;
234                }
235                   
236                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
237                    print RESULTS qq|<b>Test:  $currentcasefile - $testnum </b><br />\n|;
238                }
239                   
240                unless ($nooutput) { #skip regular STDOUT output
241                    print STDOUT qq|Test:  $currentcasefile - $testnum \n|;
242                }
243                   
244                unless ($reporttype) {  #we suppress most logging when running in a plugin mode     
245                    unless ($casefilecheck eq $currentcasefile) {
246                        unless ($currentcasefile eq $casefilelist[0]) {  #if this is the first test case file, skip printing the closing tag for the previous one
247                            print RESULTSXML qq|    </testcases>\n\n|;
248                        }
249                        print RESULTSXML qq|    <testcases file="$currentcasefile">\n\n|;
250                    }
251                    print RESULTSXML qq|        <testcase id="$testnum">\n|;
252                }
253                   
254                for (qw/description1 description2/) {
255                    next unless defined $case{$_};
256                    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
257                        print RESULTS qq|$case{$_} <br />\n|;
258                        unless ($nooutput) { #skip regular STDOUT output
259                            print STDOUT qq|$case{$_} \n|;
260                        }
261                        print RESULTSXML qq|            <$_>$case{$_}</$_>\n|;
262                    }
263                }                   
264                   
265                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
266                    print RESULTS qq|<br />\n|;
267                }
268
269                for (qw/verifypositive verifypositive1 verifypositive2 verifypositive3
270                        verifynegative verifynegative1 verifynegative2 verifynegative3/) {
271                    my $negative = $_ =~ /negative/ ? "Negative" : "";
272                    if ($case{$_}) {
273                        unless ($reporttype) {  #we suppress most logging when running in a plugin mode
274                            print RESULTS qq|Verify $negative: "$case{$_}" <br />\n|;
275                            unless ($nooutput) { #skip regular STDOUT output
276                                print STDOUT qq|Verify $negative: "$case{$_}" \n|;
277                            }
278                            print RESULTSXML qq|            <$_>$case{$_}</$_>\n|;
279                        }
280                    }
281                }                   
282
283                if ($case{verifypositivenext}) {
284                    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
285                        print RESULTS qq|Verify On Next Case: "$case{verifypositivenext}" <br />\n|;
286                        unless ($nooutput) { #skip regular STDOUT output 
287                            print STDOUT qq|Verify On Next Case: "$case{verifypositivenext}" \n|;
288                        }
289                        print RESULTSXML qq|            <verifypositivenext>$case{verifypositivenext}</verifypositivenext>\n|;
290                    }
291                }
292                   
293                if ($case{verifynegativenext}) {
294                    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
295                        print RESULTS qq|Verify Negative On Next Case: "$case{verifynegativenext}" <br />\n|;
296                        unless ($nooutput) { #skip regular STDOUT output 
297                            print STDOUT qq|Verify Negative On Next Case: "$case{verifynegativenext}" \n|;
298                        }
299                        print RESULTSXML qq|            <verifynegativenext>$case{verifynegativenext}</verifynegativenext>\n|;
300                    }
301                }
302                   
303                if ($case{verifyresponsecode}) {
304                    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
305                        print RESULTS qq|Verify Response Code: "$case{verifyresponsecode}" <br />\n|;
306                        unless ($nooutput) { #skip regular STDOUT output
307                            print STDOUT qq|Verify Response Code: "$case{verifyresponsecode}" \n|;
308                        }
309                        print RESULTSXML qq|            <verifyresponsecode>$case{verifyresponsecode}</verifyresponsecode>\n|;
310                    }
311                }
312                   
313                   
314                if ($case{method}) {
315                    if ($case{method} eq "get") { httpget(); }
316                    elsif ($case{method} eq "post") { httppost(); }
317                    else { print STDERR qq|ERROR: bad HTTP Request Method Type, you must use "get" or "post"\n|; }
318                }
319                else {   
320                    httpget();  #use "get" if no method is specified 
321                } 
322                   
323                   
324                verify();  #verify result from http response
325                   
326                httplog();  #write to http.log file
327                   
328                plotlog($latency);  #send perf data to log file for plotting
329                   
330                plotit();  #call the external plotter to create a graph
331                 
332                if ($gui == 1) {
333                    gui_updatemontab();  #update monitor with the newly rendered plot graph
334                }   
335                   
336                   
337                parseresponse();  #grab string from response to send later
338                   
339                   
340                if ($isfailure > 0) {  #if any verification fails, test case is considered a failure
341                    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
342                        print RESULTSXML qq|            <success>false</success>\n|;
343                    }
344                    if ($case{errormessage}) { #Add defined error message to the output
345                        unless ($reporttype) {  #we suppress most logging when running in a plugin mode
346                            print RESULTS qq|<b><span class="fail">TEST CASE FAILED : $case{errormessage}</span></b><br />\n|;
347                            print RESULTSXML qq|            <result-message>$case{errormessage}</result-message>\n|;
348                        }
349                        unless ($nooutput) { #skip regular STDOUT output
350                            print STDOUT qq|TEST CASE FAILED : $case{errormessage}\n|;
351                        }
352                    }
353                    else { #print regular error output
354                        unless ($reporttype) {  #we suppress most logging when running in a plugin mode
355                            print RESULTS qq|<b><span class="fail">TEST CASE FAILED</span></b><br />\n|;
356                            print RESULTSXML qq|            <result-message>TEST CASE FAILED</result-message>\n|;
357                        }
358                        unless ($nooutput) { #skip regular STDOUT output
359                            print STDOUT qq|TEST CASE FAILED\n|;
360                        }
361                    }   
362                    unless ($returnmessage) {  #(used for plugin compatibility) if it's the first error message, set it to variable
363                        if ($case{errormessage}) {
364                            $returnmessage = $case{errormessage};
365                        }
366                        else {
367                            $returnmessage = "Test case number $testnum failed";
368                        }
369                        #print "\nReturn Message : $returnmessage\n"
370                    }
371                    if ($gui == 1){
372                        gui_status_failed();
373                    }
374                    $casefailedcount++;
375                }
376                else {
377                    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
378                        print RESULTS qq|<b><span class="pass">TEST CASE PASSED</span></b><br />\n|;
379                    }
380                    unless ($nooutput) { #skip regular STDOUT output
381                        print STDOUT qq|TEST CASE PASSED \n|;
382                    }
383                    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
384                        print RESULTSXML qq|            <success>true</success>\n|;
385                        print RESULTSXML qq|            <result-message>TEST CASE PASSED</result-message>\n|;
386                    }
387                    if ($gui == 1){
388                        gui_status_passed();
389                    }
390                    $casepassedcount++;
391                }
392                   
393                   
394                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
395                    print RESULTS qq|Response Time = $latency sec <br />\n|;
396                }
397                   
398                if ($gui == 1) { gui_timer_output(); }
399                   
400                unless ($nooutput) { #skip regular STDOUT output
401                    print STDOUT qq|Response Time = $latency sec \n|;
402                }
403                   
404                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
405                    print RESULTSXML qq|            <responsetime>$latency</responsetime>\n|;
406                    print RESULTSXML qq|        </testcase>\n\n|;
407                    print RESULTS qq|<br />\n------------------------------------------------------- <br />\n\n|;
408                }
409                   
410                unless ($xnode or $nooutput) { #skip regular STDOUT output if using an XPath or $nooutput is set   
411                    print STDOUT qq|------------------------------------------------------- \n|;
412                }
413                   
414                $casefilecheck = $currentcasefile;  #set this so <testcases> xml is only closed after each file is done processing
415                   
416                $endruntimer = time();
417                $totalruntime = (int(1000 * ($endruntimer - $startruntimer)) / 1000);  #elapsed time rounded to thousandths
418                   
419                $runcount++;   
420                $totalruncount++;
421                   
422                if ($gui == 1) {
423                    gui_statusbar();  #update the statusbar
424                }   
425                   
426                if ($latency > $maxresponse) { $maxresponse = $latency; }  #set max response time
427                if ($latency < $minresponse) { $minresponse = $latency; }  #set min response time
428                $totalresponse = ($totalresponse + $latency);  #keep total of response times for calculating avg
429                $avgresponse = (int(1000 * ($totalresponse / $totalruncount)) / 1000);  #avg response rounded to thousandths
430                   
431                if ($gui == 1) { gui_updatemonstats(); }  #update timers and counts in monitor tab   
432                   
433                #break from sub if user presses stop button in gui   
434                if ($stop eq 'yes') {
435                    finaltasks();
436                    $stop = 'no';
437                    return;  #break from sub
438                }
439                   
440                if ($case{sleep}) {  #if a sleep value is set in the test case, sleep that amount
441                    sleep($case{sleep})
442                }
443                   
444                if ($xnode) {  #if an XPath Node is defined, only process the single Node
445                    last;
446                }
447                   
448            }
449               
450            $testnum = 1;  #reset testcase counter so it will reprocess test case file if repeat is set
451        }
452    }
453       
454    finaltasks();  #do return/cleanup tasks
455       
456} #end engine subroutine
457
458
459
460#------------------------------------------------------------------
461#  SUBROUTINES
462#------------------------------------------------------------------
463sub writeinitialhtml {  #write opening tags for results file
464       
465    print RESULTS
466qq|<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
467    "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
468
469<html xmlns="http://www.w3.org/1999/xhtml">
470<head>
471    <title>WebInject Test Results</title>
472    <meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
473    <style type="text/css">
474        body {
475            background-color: #F5F5F5;
476            color: #000000;
477            font-family: Verdana, Arial, Helvetica, sans-serif;
478            font-size: 10px;
479        }
480        .pass {
481            color: green;
482        }
483        .fail {
484            color: red;
485        }
486    </style>
487</head>
488<body>
489<hr />
490-------------------------------------------------------<br />
491|;
492}
493#------------------------------------------------------------------
494sub writeinitialstdout {  #write initial text for STDOUT
495       
496    print STDOUT
497qq|
498Starting WebInject Engine...
499
500-------------------------------------------------------
501|;
502}
503#------------------------------------------------------------------
504sub writefinalhtml {  #write summary and closing tags for results file
505       
506    print RESULTS
507qq|   
508<br /><hr /><br />
509<b>
510Start Time: $currentdatetime <br />
511Total Run Time: $totalruntime seconds <br />
512<br />
513Test Cases Run: $totalruncount <br />
514Test Cases Passed: $casepassedcount <br />
515Test Cases Failed: $casefailedcount <br />
516Verifications Passed: $passedcount <br />
517Verifications Failed: $failedcount <br />
518<br />
519Average Response Time: $avgresponse seconds <br />
520Max Response Time: $maxresponse seconds <br />
521Min Response Time: $minresponse seconds <br />
522</b>
523<br />
524
525</body>
526</html>
527|;
528}
529#------------------------------------------------------------------
530sub writefinalxml {  #write summary and closing tags for XML results file
531       
532    print RESULTSXML
533qq|   
534    </testcases>
535
536    <test-summary>
537        <start-time>$currentdatetime</start-time>
538        <total-run-time>$totalruntime</total-run-time>
539        <test-cases-run>$totalruncount</test-cases-run>
540        <test-cases-passed>$casepassedcount</test-cases-passed>
541        <test-cases-failed>$casefailedcount</test-cases-failed>
542        <verifications-passed>$passedcount</verifications-passed>
543        <verifications-failed>$failedcount</verifications-failed>
544        <average-response-time>$avgresponse</average-response-time>
545        <max-response-time>$maxresponse</max-response-time>
546        <min-response-time>$minresponse</min-response-time>
547    </test-summary>
548
549</results>
550|;
551}
552#------------------------------------------------------------------
553sub writefinalstdout {  #write summary and closing text for STDOUT
554       
555    print STDOUT
556qq|   
557Start Time: $currentdatetime
558Total Run Time: $totalruntime seconds
559
560Test Cases Run: $totalruncount
561Test Cases Passed: $casepassedcount
562Test Cases Failed: $casefailedcount
563Verifications Passed: $passedcount
564Verifications Failed: $failedcount
565
566|;
567}
568#------------------------------------------------------------------
569sub httpget {  #send http request and read response
570       
571    $request = new HTTP::Request('GET',"$case{url}");
572   
573    if ($case{addheader}) {  #add an additional HTTP Header if specified
574        my @addheaders = split(/\|/, $case{addheader});  #can add multiple headers with a pipe delimiter
575        foreach (@addheaders) {
576            $_ =~ m~(.*): (.*)~;
577            $request->header($1 => $2);  #using HTTP::Headers Class
578        }
579        $case{addheader} = '';
580    }
581   
582    $cookie_jar->add_cookie_header($request);
583    #print $request->as_string; print "\n\n";
584       
585    $starttimer = time();
586    $response = $useragent->request($request);
587    $endtimer = time();
588    $latency = (int(1000 * ($endtimer - $starttimer)) / 1000);  #elapsed time rounded to thousandths
589    #print $response->as_string; print "\n\n";
590       
591    $cookie_jar->extract_cookies($response);
592    #print $cookie_jar->as_string; print "\n\n";
593}
594#------------------------------------------------------------------
595sub httppost {  #post request based on specified encoding
596       
597    if ($case{posttype}) {
598        if ($case{posttype} =~ m~application/x-www-form-urlencoded~) { httppost_form_urlencoded(); }
599        elsif ($case{posttype} =~ m~multipart/form-data~) { httppost_form_data(); }
600        elsif (($case{posttype} =~ m~text/xml~) or ($case{posttype} =~ m~application/soap+xml~)) { httppost_xml(); }
601        else { print STDERR qq|ERROR: Bad Form Encoding Type, I only accept "application/x-www-form-urlencoded", "multipart/form-data", "text/xml", "application/soap+xml" \n|; }
602    }
603    else {   
604        $case{posttype} = 'application/x-www-form-urlencoded';
605        httppost_form_urlencoded();  #use "x-www-form-urlencoded" if no encoding is specified 
606    }
607}
608#------------------------------------------------------------------
609sub httppost_form_urlencoded {  #send application/x-www-form-urlencoded HTTP request and read response
610       
611    $request = new HTTP::Request('POST',"$case{url}");
612    $request->content_type("$case{posttype}");
613    $request->content("$case{postbody}");
614   
615    if ($case{addheader}) {  #add an additional HTTP Header if specified
616        my @addheaders = split(/\|/, $case{addheader});  #can add multiple headers with a pipe delimiter
617        foreach (@addheaders) {
618            $_ =~ m~(.*): (.*)~;
619            $request->header($1 => $2);  #using HTTP::Headers Class
620        }
621        $case{addheader} = '';
622    }
623   
624    $cookie_jar->add_cookie_header($request);
625    #print $request->as_string; print "\n\n";
626    $starttimer = time();
627    $response = $useragent->request($request);
628    $endtimer = time();
629    $latency = (int(1000 * ($endtimer - $starttimer)) / 1000);  #elapsed time rounded to thousandths
630    #print $response->as_string; print "\n\n";
631       
632    $cookie_jar->extract_cookies($response);
633    #print $cookie_jar->as_string; print "\n\n";
634}
635#------------------------------------------------------------------
636sub httppost_xml{  #send text/xml HTTP request and read response
637   
638    #read the xml file specified in the testcase
639    $case{postbody} =~ m~file=>(.*)~i;
640    open(XMLBODY, "$dirname"."$1") or die "\nError: Failed to open text/xml file\n\n";  #open file handle   
641    my @xmlbody = <XMLBODY>;  #read the file into an array   
642    close(XMLBODY);
643       
644    $request = new HTTP::Request('POST', "$case{url}");
645    $request->content_type("$case{posttype}");
646    $request->content(join(" ", @xmlbody));  #load the contents of the file into the request body
647   
648    if ($case{addheader}) {  #add an additional HTTP Header if specified
649        my @addheaders = split(/\|/, $case{addheader});  #can add multiple headers with a pipe delimiter
650        foreach (@addheaders) {
651            $_ =~ m~(.*): (.*)~;
652            $request->header($1 => $2);  #using HTTP::Headers Class
653        }
654        $case{addheader} = '';
655    }
656   
657    $cookie_jar->add_cookie_header($request);
658    #print $request->as_string; print "\n\n";   
659    $starttimer = time();
660    $response = $useragent->request($request);
661    $endtimer = time();
662    $latency = (int(1000 * ($endtimer - $starttimer)) / 1000);  #elapsed time rounded to thousandths
663    #print $response->as_string; print "\n\n";   
664
665    $cookie_jar->extract_cookies($response);
666    #print $cookie_jar->as_string; print "\n\n";
667
668
669    my $xmlparser = new XML::Parser;
670    try {  #see if the XML parses properly
671        $xmlparser->parse($response->content);
672        #print "good xml\n";
673        unless ($reporttype) {  #we suppress most logging when running in a plugin mode
674            print RESULTS qq|<span class="pass">Passed XML Parser (content is well-formed)</span><br />\n|;
675            print RESULTSXML qq|            <verifyxml-success>true</verifyxml-success>\n|;
676        }
677        unless ($nooutput) { #skip regular STDOUT output
678            print STDOUT "Passed XML Parser (content is well-formed) \n";
679        }
680        $passedcount++;
681        return; #exit try block
682    }
683    catch Error with {
684        my $ex = shift;  #get the exception object
685        #print "bad xml\n";
686        unless ($reporttype) {  #we suppress most logging when running in a plugin mode
687            print RESULTS qq|<span class="fail">Failed XML Parser: $ex</span><br />\n|;
688            print RESULTSXML qq|            <verifyxml-success>false</verifyxml-success>\n|;
689        }
690        unless ($nooutput) { #skip regular STDOUT output 
691            print STDOUT "Failed XML Parser: $ex \n";         
692        }
693        $failedcount++;
694        $isfailure++;
695    };  # <-- remember the semicolon
696
697}
698#------------------------------------------------------------------
699sub httppost_form_data {  #send multipart/form-data HTTP request and read response
700       
701    my %myContent_;
702    eval "\%myContent_ = $case{postbody}";
703    $request = POST "$case{url}",
704               Content_Type => "$case{posttype}",
705               Content => \%myContent_;
706    $cookie_jar->add_cookie_header($request);
707    #print $request->as_string; print "\n\n";
708   
709    if ($case{addheader}) {  #add an additional HTTP Header if specified
710        my @addheaders = split(/\|/, $case{addheader});  #can add multiple headers with a pipe delimiter
711        foreach (@addheaders) {
712            $_ =~ m~(.*): (.*)~;
713            $request->header($1 => $2);  #using HTTP::Headers Class
714        }
715        $case{addheader} = '';
716    }
717   
718    $starttimer = time();
719    $response = $useragent->request($request);
720    $endtimer = time();
721    $latency = (int(1000 * ($endtimer - $starttimer)) / 1000);  #elapsed time rounded to thousandths
722    #print $response->as_string; print "\n\n";
723       
724    $cookie_jar->extract_cookies($response);
725    #print $cookie_jar->as_string; print "\n\n";
726}
727#------------------------------------------------------------------
728sub verify {  #do verification of http response and print status to HTML/XML/STDOUT/UI
729
730    for (qw/verifypositive verifypositive1 verifypositive2 verifypositive3/) {
731   
732        if ($case{$_}) {
733            if ($response->as_string() =~ m~$case{$_}~si) {  #verify existence of string in response
734                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
735                    print RESULTS qq|<span class="pass">Passed Positive Verification</span><br />\n|;
736                    print RESULTSXML qq|            <$_-success>true</$_-success>\n|;
737                }
738                unless ($nooutput) { #skip regular STDOUT output
739                    print STDOUT "Passed Positive Verification \n";
740                }
741                $passedcount++;
742            }
743            else {
744                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
745                    print RESULTS qq|<span class="fail">Failed Positive Verification</span><br />\n|;
746                    print RESULTSXML qq|            <$_-success>false</$_-success>\n|;
747                }
748                unless ($nooutput) { #skip regular STDOUT output 
749                    print STDOUT "Failed Positive Verification \n";         
750                }
751                $failedcount++;
752                $isfailure++;
753            }
754        }
755    }   
756   
757    for (qw/verifynegative verifynegative1 verifynegative2 verifynegative3/) {       
758       
759        if ($case{$_}) {
760            if ($response->as_string() =~ m~$case{$_}~si) {  #verify existence of string in response
761                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
762                    print RESULTS qq|<span class="fail">Failed Negative Verification</span><br />\n|;
763                    print RESULTSXML qq|            <$_-success>false</$_-success>\n|;
764                }
765                unless ($nooutput) { #skip regular STDOUT output
766                    print STDOUT "Failed Negative Verification \n";           
767                }
768                $failedcount++;
769                $isfailure++;
770            }
771            else {
772                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
773                    print RESULTS qq|<span class="pass">Passed Negative Verification</span><br />\n|;
774                    print RESULTSXML qq|            <$_-success>true</$_-success>\n|;
775                }
776                unless ($nooutput) { #skip regular STDOUT output
777                    print STDOUT "Passed Negative Verification \n";
778                }
779                $passedcount++;               
780            }
781        }
782    }
783       
784    if ($verifylater) {
785        if ($response->as_string() =~ m~$verifylater~si) {  #verify existence of string in response
786            unless ($reporttype) {  #we suppress most logging when running in a plugin mode
787                print RESULTS qq|<span class="pass">Passed Positive Verification (verification set in previous test case)</span><br />\n|;
788                print RESULTSXML qq|            <verifypositivenext-success>true</verifypositivenext-success>\n|;
789            }
790            unless ($xnode or $nooutput) { #skip regular STDOUT output if using an XPath or $nooutput is set
791                print STDOUT "Passed Positive Verification (verification set in previous test case) \n";
792            }
793            $passedcount++;
794        }
795        else {
796            unless ($reporttype) {  #we suppress most logging when running in a plugin mode
797                print RESULTS qq|<span class="fail">Failed Positive Verification (verification set in previous test case)</span><br />\n|;
798                print RESULTSXML qq|            <verifypositivenext-success>false</verifypositivenext-success>\n|;
799            }
800            unless ($xnode or $nooutput) { #skip regular STDOUT output if using an XPath or $nooutput is set
801                print STDOUT "Failed Positive Verification (verification set in previous test case) \n";           
802            }
803            $failedcount++;
804            $isfailure++;           
805        }       
806        $verifylater = '';  #set to null after verification
807    }
808       
809       
810       
811    if ($verifylaterneg) {
812        if ($response->as_string() =~ m~$verifylaterneg~si) {  #verify existence of string in response
813
814            unless ($reporttype) {  #we suppress most logging when running in a plugin mode
815                print RESULTS qq|<span class="fail">Failed Negative Verification (negative verification set in previous test case)</span><br />\n|;
816                print RESULTSXML qq|            <verifynegativenext-success>false</verifynegativenext-success>\n|;
817            }
818            unless ($xnode or $nooutput) { #skip regular STDOUT output if using an XPath or $nooutput is set 
819                print STDOUT "Failed Negative Verification (negative verification set in previous test case) \n";     
820            }
821            $failedcount++;
822            $isfailure++;
823        }
824        else {
825            unless ($reporttype) {  #we suppress most logging when running in a plugin mode
826                print RESULTS qq|<span class="pass">Passed Negative Verification (negative verification set in previous test case)</span><br />\n|;
827                print RESULTSXML qq|            <verifynegativenext-success>true</verifynegativenext-success>\n|;
828            }
829            unless ($xnode or $nooutput) { #skip regular STDOUT output if using an XPath or $nooutput is set
830                print STDOUT "Passed Negative Verification (negative verification set in previous test case) \n";
831            }
832            $passedcount++;                   
833        }
834        $verifylaterneg = '';  #set to null after verification
835    }
836       
837     
838     
839    if ($case{verifyresponsecode}) {
840        if ($case{verifyresponsecode} == $response->code()) { #verify returned HTTP response code matches verifyresponsecode set in test case
841            unless ($reporttype) {  #we suppress most logging when running in a plugin mode
842                print RESULTS qq|<span class="pass">Passed HTTP Response Code Verification </span><br />\n|;
843                print RESULTSXML qq|            <verifyresponsecode-success>true</verifyresponsecode-success>\n|;
844                print RESULTSXML qq|            <verifyresponsecode-message>Passed HTTP Response Code Verification</verifyresponsecode-message>\n|;
845            }
846            unless ($nooutput) { #skip regular STDOUT output
847                print STDOUT qq|Passed HTTP Response Code Verification \n|;
848            }
849            $passedcount++;         
850            }
851        else {
852            unless ($reporttype) {  #we suppress most logging when running in a plugin mode
853                print RESULTS qq|<span class="fail">Failed HTTP Response Code Verification (received | . $response->code() .  qq|, expecting $case{verifyresponsecode})</span><br />\n|;
854                print RESULTSXML qq|            <verifyresponsecode-success>false</verifyresponsecode-success>\n|;
855                print RESULTSXML qq|            <verifyresponsecode-message>Failed HTTP Response Code Verification (received | . $response->code() .  qq|, expecting $case{verifyresponsecode})</verifyresponsecode-message>\n|;
856            }
857            unless ($nooutput) { #skip regular STDOUT output
858                print STDOUT qq|Failed HTTP Response Code Verification (received | . $response->code() .  qq|, expecting $case{verifyresponsecode}) \n|;
859            }
860            $failedcount++;
861            $isfailure++;
862        }
863    }
864    else { #verify http response code is in the 100-399 range
865        if ($response->as_string() =~ /HTTP\/1.(0|1) (1|2|3)/i) {  #verify existance of string in response
866            unless ($reporttype) {  #we suppress most logging when running in a plugin mode
867                print RESULTS qq|<span class="pass">Passed HTTP Response Code Verification (not in error range)</span><br />\n|;
868                print RESULTSXML qq|            <verifyresponsecode-success>true</verifyresponsecode-success>\n|;
869                print RESULTSXML qq|            <verifyresponsecode-message>Passed HTTP Response Code Verification (not in error range)</verifyresponsecode-message>\n|;
870            }
871            unless ($nooutput) { #skip regular STDOUT output
872                print STDOUT qq|Passed HTTP Response Code Verification (not in error range) \n|;
873            }
874            #succesful response codes: 100-399
875            $passedcount++;         
876        }
877        else {
878            $response->as_string() =~ /(HTTP\/1.)(.*)/i;
879            if ($1) {  #this is true if an HTTP response returned
880                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
881                    print RESULTS qq|<span class="fail">Failed HTTP Response Code Verification ($1$2)</span><br />\n|; #($1$2) is HTTP response code
882                    print RESULTSXML qq|            <verifyresponsecode-success>false</verifyresponsecode-success>\n|;
883                    print RESULTSXML qq|            <verifyresponsecode-message>Failed HTTP Response Code Verification ($1$2)</verifyresponsecode-message>\n|;
884                }
885                unless ($nooutput) { #skip regular STDOUT output
886                    print STDOUT "Failed HTTP Response Code Verification ($1$2) \n"; #($1$2) is HTTP response code   
887                }
888            }
889            else {  #no HTTP response returned.. could be error in connection, bad hostname/address, or can not connect to web server
890                unless ($reporttype) {  #we suppress most logging when running in a plugin mode
891                    print RESULTS qq|<span class="fail">Failed - No Response</span><br />\n|; #($1$2) is HTTP response code
892                    print RESULTSXML qq|            <verifyresponsecode-success>false</verifyresponsecode-success>\n|;
893                    print RESULTSXML qq|            <verifyresponsecode-message>Failed - No Response</verifyresponsecode-message>\n|;
894                }
895                unless ($nooutput) { #skip regular STDOUT output 
896                    print STDOUT "Failed - No Response \n"; #($1$2) is HTTP response code   
897                }
898            }
899            $failedcount++;
900            $isfailure++;
901        }
902    }       
903}
904#------------------------------------------------------------------
905sub parseresponse {  #parse values from responses for use in future request (for session id's, dynamic URL rewriting, etc)
906       
907    our ($resptoparse, @parseargs);
908    our ($leftboundary, $rightboundary, $escape);
909     
910
911    for (qw/parseresponse parseresponse1 parseresponse2 parseresponse3 parseresponse4 parseresponse5/) {
912
913        next unless $case{$_};
914
915        @parseargs = split(/\|/, $case{$_});
916           
917        $leftboundary = $parseargs[0]; $rightboundary = $parseargs[1]; $escape = $parseargs[2];
918           
919        $resptoparse = $response->as_string;
920        if ($resptoparse =~ m~$leftboundary(.*?)$rightboundary~s) {
921            $parsedresult{$_} = $1;
922        }
923           
924        if ($escape) {
925            if ($escape eq 'escape') {
926                $parsedresult{$_} = url_escape($parsedresult{$_});
927            }
928        }
929        #print "\n\nParsed String: $parsedresult{$_}\n\n";
930    }
931
932       
933}
934#------------------------------------------------------------------
935sub processcasefile {  #get test case files to run (from command line or config file) and evaluate constants
936                       #parse config file and grab values it sets
937       
938    my @configfile;
939    my $configexists = 0;
940    my $comment_mode;
941    my $firstparse;
942    my $filename;
943    my $xpath;
944    my $setuseragent;
945       
946    undef @casefilelist; #empty the array of test case filenames
947    undef @configfile;
948       
949    #process the config file
950    if ($opt_configfile) {  #if -c option was set on command line, use specified config file
951        open(CONFIG, "$dirname"."$opt_configfile") or die "\nERROR: Failed to open $opt_configfile file\n\n";
952        $configexists = 1;  #flag we are going to use a config file
953    }
954    elsif (-e "$dirname"."config.xml") {  #if config.xml exists, read it
955        open(CONFIG, "$dirname"."config.xml") or die "\nERROR: Failed to open config.xml file\n\n";
956        $configexists = 1;  #flag we are going to use a config file
957    }
958       
959    if ($configexists) {  #if we have a config file, use it 
960           
961        my @precomment = <CONFIG>;  #read the config file into an array
962           
963        #remove any commented blocks from config file
964         foreach (@precomment) {
965            unless (m~<comment>.*</comment>~) {  #single line comment
966                #multi-line comments
967                if (/<comment>/) {   
968                    $comment_mode = 1;
969                }
970                elsif (m~</comment>~) {   
971                    $comment_mode = 0;
972                }
973                elsif (!$comment_mode) {
974                    push(@configfile, $_);
975                }
976            }
977        }
978    }
979       
980    if (($#ARGV + 1) < 1) {  #no command line args were passed 
981        #if testcase filename is not passed on the command line, use files in config.xml 
982        #parse test case file names from config.xml and build array
983        foreach (@configfile) {
984               
985            if (/<testcasefile>/) {   
986                $firstparse = $';  #print "$' \n\n";
987                $firstparse =~ m~</testcasefile>~;
988                $filename = $`;  #string between tags will be in $filename
989                #print "\n$filename \n\n";
990                push @casefilelist, $filename;  #add next filename we grab to end of array
991            }
992        }   
993           
994        unless ($casefilelist[0]) {
995            if (-e "$dirname"."testcases.xml") {
996                #not appending a $dirname here since we append one when we open the file
997                push @casefilelist, "testcases.xml";  #if no files are specified in config.xml, default to testcases.xml
998            }
999            else {
1000                die "\nERROR: I can't find any test case files to run.\nYou must either use a config file or pass a filename " .
1001                    "on the command line if you are not using the default testcase file (testcases.xml).";
1002            }
1003        }
1004    }
1005       
1006    elsif (($#ARGV + 1) == 1) {  #one command line arg was passed
1007        #use testcase filename passed on command line (config.xml is only used for other options)
1008        push @casefilelist, $ARGV[0];  #first commandline argument is the test case file, put this on the array for processing
1009    }
1010       
1011    elsif (($#ARGV + 1) == 2) {  #two command line args were passed
1012           
1013        undef $xnode; #reset xnode
1014        undef $xpath; #reset xpath
1015           
1016        $xpath = $ARGV[1];
1017           
1018        if ($xpath =~ /\/(.*)\[/) {  #if the argument contains a "/" and "[", it is really an XPath 
1019            $xpath =~ /(.*)\/(.*)\[(.*?)\]/;  #if it contains XPath info, just grab the file name
1020            $xnode = $3;  #grab the XPath Node value.. (from inside the "[]")
1021            #print "\nXPath Node is: $xnode \n";
1022        }
1023        else {
1024            print STDERR "\nSorry, $xpath is not in the XPath format I was expecting, I'm ignoring it...\n";
1025        }
1026           
1027        #use testcase filename passed on command line (config.xml is only used for other options)       
1028        push @casefilelist, $ARGV[0];  #first command line argument is the test case file, put this on the array for processing
1029    }
1030       
1031    elsif (($#ARGV + 1) > 2) {  #too many command line args were passed
1032        die "\nERROR: Too many arguments\n\n";
1033    }
1034       
1035    #print "\ntestcase file list: @casefilelist\n\n";
1036       
1037       
1038    #grab values for constants in config file:
1039    foreach (@configfile) {
1040
1041        for my $config_const (qw/baseurl baseurl1 baseurl2 gnuplot proxy timeout
1042                globaltimeout globalhttplog standaloneplot/) {
1043
1044            if (/<$config_const>/) {
1045                $_ =~ m~<$config_const>(.*)</$config_const>~;
1046                $config{$config_const} = $1;
1047                #print "\n$_ : $config{$_} \n\n";
1048            }
1049        }
1050           
1051        if (/<reporttype>/) {   
1052            $_ =~ m~<reporttype>(.*)</reporttype>~;
1053            if ($1 ne "standard") {
1054               $reporttype = $1;
1055               $nooutput = "set";
1056            }
1057            #print "\nreporttype : $reporttype \n\n";
1058        }   
1059           
1060        if (/<useragent>/) {   
1061            $_ =~ m~<useragent>(.*)</useragent>~;
1062            $setuseragent = $1;
1063            if ($setuseragent) { #http useragent that will show up in webserver logs
1064                $useragent->agent($setuseragent);
1065            } 
1066            #print "\nuseragent : $setuseragent \n\n";
1067        }
1068         
1069        if (/<httpauth>/) {
1070                #each time we see an <httpauth>, we set @authentry to be the
1071                #array of values, then we use [] to get a reference to that array
1072                #and push that reference onto @httpauth.             
1073            my @authentry;
1074            $_ =~ m~<httpauth>(.*)</httpauth>~;
1075            @authentry = split(/:/, $1);
1076            if ($#authentry != 4) {
1077                print STDERR "\nError: httpauth should have 5 fields delimited by colons\n\n";
1078            }
1079            else {
1080                push(@httpauth, [@authentry]);
1081            }
1082            #print "\nhttpauth : @httpauth \n\n";
1083        }
1084           
1085    } 
1086       
1087    close(CONFIG);
1088}
1089#------------------------------------------------------------------
1090sub convtestcases { 
1091    #here we do some pre-processing of the test case file and write it out to a temp file.
1092    #we convert certain chars so xml parser doesn't puke.
1093       
1094    my @xmltoconvert;       
1095       
1096    open(XMLTOCONVERT, "$dirname"."$currentcasefile") or die "\nError: Failed to open test case file\n\n";  #open file handle   
1097    @xmltoconvert = <XMLTOCONVERT>;  #read the file into an array
1098       
1099    $casecount = 0;
1100       
1101    foreach (@xmltoconvert){
1102           
1103        #convert escaped chars and certain reserved chars to temporary values that the parser can handle
1104        #these are converted back later in processing
1105        s/&/{AMPERSAND}/g; 
1106        s/\\</{LESSTHAN}/g;     
1107           
1108        #count cases while we are here   
1109        if ($_ =~ /<case/) {  #count test cases based on '<case' tag
1110            $casecount++;
1111        }   
1112    } 
1113       
1114    close(XMLTOCONVERT);   
1115       
1116    open(XMLTOCONVERT, ">$dirname"."$currentcasefile".".$$".".tmp") or die "\nERROR: Failed to open temp file for writing\n\n";  #open file handle to temp file 
1117    print XMLTOCONVERT @xmltoconvert;  #overwrite file with converted array
1118    close(XMLTOCONVERT);
1119}
1120#------------------------------------------------------------------
1121sub fixsinglecase{ #xml parser creates a hash in a different format if there is only a single testcase.
1122                   #add a dummy testcase to fix this situation
1123       
1124    my @xmltoconvert;
1125       
1126    if ($casecount == 1) {
1127           
1128        open(XMLTOCONVERT, "$dirname"."$currentcasefile".".$$".".tmp") or die "\nError: Failed to open temp file\n\n";  #open file handle   
1129        @xmltoconvert = <XMLTOCONVERT>;  #read the file into an array
1130           
1131        for(@xmltoconvert) {
1132            s/<\/testcases>/<case id="2" description1="dummy test case"\/><\/testcases>/g;  #add dummy test case to end of file   
1133        }       
1134        close(XMLTOCONVERT);
1135           
1136        open(XMLTOCONVERT, ">$dirname"."$currentcasefile".".$$".".tmp") or die "\nERROR: Failed to open temp file for writing\n\n";  #open file handle   
1137        print XMLTOCONVERT @xmltoconvert;  #overwrite file with converted array
1138        close(XMLTOCONVERT);
1139    }
1140}
1141#------------------------------------------------------------------
1142sub convertbackxml() {  #converts replaced xml with substitutions
1143
1144    $_[0] =~ s~{AMPERSAND}~&~g;
1145    $_[0] =~ s~{LESSTHAN}~<~g;
1146    $_[0] =~ s~{TIMESTAMP}~$timestamp~g;
1147    $_[0] =~ s~{BASEURL}~$config{baseurl}~g;
1148    $_[0] =~ s~{BASEURL1}~$config{baseurl1}~g;
1149    $_[0] =~ s~{BASEURL2}~$config{baseurl2}~g;
1150    $_[0] =~ s~{PARSEDRESULT}~$parsedresult{parseresponse}~g;
1151    $_[0] =~ s~{PARSEDRESULT1}~$parsedresult{parseresponse1}~g;
1152    $_[0] =~ s~{PARSEDRESULT2}~$parsedresult{parseresponse2}~g;
1153    $_[0] =~ s~{PARSEDRESULT3}~$parsedresult{parseresponse3}~g;
1154    $_[0] =~ s~{PARSEDRESULT4}~$parsedresult{parseresponse4}~g;
1155    $_[0] =~ s~{PARSEDRESULT5}~$parsedresult{parseresponse5}~g;
1156}
1157#------------------------------------------------------------------
1158sub url_escape {  #escapes difficult characters with %hexvalue
1159    #LWP handles url encoding already, but use this to escape valid chars that LWP won't convert (like +)
1160       
1161    my @a = @_;  #make a copy of the arguments
1162       
1163    map { s/[^-\w.,!~'()\/ ]/sprintf "%%%02x", ord $&/eg } @a;
1164    return wantarray ? @a : $a[0];
1165}
1166#------------------------------------------------------------------
1167sub httplog {  #write requests and responses to http.log file
1168       
1169    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
1170       
1171        if ($case{logrequest} && ($case{logrequest} =~ /yes/i)) {  #http request - log setting per test case
1172            print HTTPLOGFILE $request->as_string, "\n\n";
1173        }
1174           
1175        if ($case{logresponse} && ($case{logresponse} =~ /yes/i)) {  #http response - log setting per test case
1176            print HTTPLOGFILE $response->as_string, "\n\n";
1177        }
1178           
1179        if ($config{globalhttplog} && ($config{globalhttplog} =~ /yes/i)) {  #global http log setting
1180            print HTTPLOGFILE $request->as_string, "\n\n";
1181            print HTTPLOGFILE $response->as_string, "\n\n";
1182        }
1183           
1184        if (($config{globalhttplog} && ($config{globalhttplog} =~ /onfail/i)) && ($isfailure > 0)) { #global http log setting - onfail mode
1185            print HTTPLOGFILE $request->as_string, "\n\n";
1186            print HTTPLOGFILE $response->as_string, "\n\n";
1187        }
1188           
1189        if (($case{logrequest} && ($case{logrequest} =~ /yes/i)) or
1190            ($case{logresponse} && ($case{logresponse} =~ /yes/i)) or
1191            ($config{globalhttplog} && ($config{globalhttplog} =~ /yes/i)) or
1192            (($config{globalhttplog} && ($config{globalhttplog} =~ /onfail/i)) && ($isfailure > 0))
1193           ) {     
1194                print HTTPLOGFILE "\n************************* LOG SEPARATOR *************************\n\n\n";
1195        }
1196    }
1197}
1198#------------------------------------------------------------------
1199sub plotlog {  #write performance results to plot.log in the format gnuplot can use
1200       
1201    our (%months, $date, $time, $mon, $mday, $hours, $min, $sec, $year, $value);
1202       
1203    #do this unless: monitor is disabled in gui, or running standalone mode without config setting to turn on plotting     
1204    unless ((($gui == 1) and ($monitorenabledchkbx eq 'monitor_off')) or (($gui == 0) and ($config{standaloneplot} ne 'on'))) { 
1205           
1206        %months = ("Jan" => 1, "Feb" => 2, "Mar" => 3, "Apr" => 4, "May" => 5, "Jun" => 6,
1207                   "Jul" => 7, "Aug" => 8, "Sep" => 9, "Oct" => 10, "Nov" => 11, "Dec" => 12);
1208           
1209        local ($value) = @_;
1210        $date = scalar localtime;
1211        ($mon, $mday, $hours, $min, $sec, $year) = $date =~
1212            /\w+ (\w+) +(\d+) (\d\d):(\d\d):(\d\d) (\d\d\d\d)/;
1213           
1214        $time = "$months{$mon} $mday $hours $min $sec $year";
1215           
1216        if ($plotclear eq 'yes') {  #used to clear the graph when requested
1217            open(PLOTLOG, ">$dirname"."plot.log") or die "ERROR: Failed to open file plot.log\n";  #open in clobber mode so log gets truncated
1218            $plotclear = 'no';  #reset the value
1219        }
1220        else {
1221            open(PLOTLOG, ">>$dirname"."plot.log") or die "ERROR: Failed to open file plot.log\n";  #open in append mode
1222        }
1223         
1224        printf PLOTLOG "%s %2.4f\n", $time, $value;
1225        close(PLOTLOG);
1226    }   
1227}
1228#------------------------------------------------------------------
1229sub gnuplotcfg {  #create gnuplot config file
1230       
1231    #do this unless: monitor is disabled in gui, or running standalone mode without config setting to turn on plotting     
1232    unless ((($gui == 1) and ($monitorenabledchkbx eq 'monitor_off')) or (($gui == 0) and ($config{standaloneplot} ne 'on'))) { 
1233       
1234        open(GNUPLOTPLT, ">$dirname"."plot.plt") || die "Could not open file\n";
1235        print GNUPLOTPLT qq|
1236set term png
1237set output \"plot.png\"
1238set size 1.1,0.5
1239set pointsize .5
1240set xdata time
1241set ylabel \"Response Time (seconds)\"
1242set yrange [0:]
1243set bmargin 2
1244set tmargin 2
1245set timefmt \"%m %d %H %M %S %Y\"
1246plot \"plot.log\" using 1:7 title \"Response Times" w $graphtype
1247|;     
1248        close(GNUPLOTPLT);
1249       
1250    }
1251}
1252#------------------------------------------------------------------
1253sub finaltasks {  #do ending tasks
1254       
1255    if ($gui == 1){ gui_stop(); }
1256       
1257    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
1258        writefinalhtml();  #write summary and closing tags for results file
1259    }
1260       
1261    unless ($xnode or $reporttype) { #skip regular STDOUT output if using an XPath or $reporttype is set ("standard" does not set this)
1262        writefinalstdout();  #write summary and closing tags for STDOUT
1263    }
1264       
1265    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
1266        writefinalxml();  #write summary and closing tags for XML results file
1267    }
1268   
1269    unless ($reporttype) {  #we suppress most logging when running in a plugin mode
1270        #these handles shouldn't be open   
1271        close(HTTPLOGFILE);
1272        close(RESULTS);
1273        close(RESULTSXML);
1274    }   
1275       
1276       
1277    #plugin modes
1278    if ($reporttype) {  #return value is set which corresponds to a monitoring program
1279           
1280        #Nagios plugin compatibility
1281        if ($reporttype eq 'nagios') { #report results in Nagios format
1282            #predefined exit codes for Nagios
1283            %exit_codes  = ('UNKNOWN' ,-1,
1284                            'OK'      , 0,
1285                            'WARNING' , 1,
1286                            'CRITICAL', 2,);
1287
1288            my $end = defined $config{globaltimeout} ? "$config{globaltimeout};;0" : ";;0";
1289
1290            if ($casefailedcount > 0) {
1291                print "WebInject CRITICAL - $returnmessage |time=$totalruntime;$end\n";
1292                exit $exit_codes{'CRITICAL'};
1293            }
1294            elsif (($config{globaltimeout}) && ($totalruntime > $config{globaltimeout})) {
1295                print "WebInject WARNING - All tests passed successfully but global timeout ($config{globaltimeout} seconds) has been reached |time=$totalruntime;$end\n";
1296                exit $exit_codes{'WARNING'};
1297            }
1298            else {
1299                print "WebInject OK - All tests passed successfully in $totalruntime seconds |time=$totalruntime;$end\n";
1300                exit $exit_codes{'OK'};
1301            }
1302        }
1303           
1304        #MRTG plugin compatibility
1305        elsif ($reporttype eq 'mrtg') { #report results in MRTG format
1306            if ($casefailedcount > 0) {
1307                print "$totalruntime\n$totalruntime\n\nWebInject CRITICAL - $returnmessage \n";
1308                exit(0);
1309            }
1310            else {
1311                print "$totalruntime\n$totalruntime\n\nWebInject OK - All tests passed successfully in $totalruntime seconds \n";
1312                exit(0);
1313            }
1314        }
1315       
1316        #External plugin. To use it, add something like that in the config file:
1317        # <reporttype>external:/home/webinject/Plugin.pm</reporttype>
1318        elsif ($reporttype =~ /^external:(.*)/) {
1319            unless (my $return = do $1) {
1320                die "couldn't parse $1: $@\n" if $@;
1321                die "couldn't do $1: $!\n" unless defined $return;
1322                die "couldn't run $1\n" unless $return;
1323            }
1324        }
1325
1326        else {
1327            print STDERR "\nError: only 'nagios', 'mrtg', 'external', or 'standard' are supported reporttype values\n\n";
1328        }
1329           
1330    }
1331       
1332}
1333#------------------------------------------------------------------
1334sub whackoldfiles {  #delete any files leftover from previous run if they exist
1335       
1336    if (-e "$dirname"."plot.log") { unlink "$dirname"."plot.log"; }
1337    if (-e "$dirname"."plot.plt") { unlink "$dirname"."plot.plt"; }
1338    if (-e "$dirname"."plot.png") { unlink "$dirname"."plot.png"; }
1339    if (glob("$dirname"."*.xml.tmp")) { unlink glob("$dirname"."*.xml.tmp"); }
1340       
1341    #verify files are deleted, if not give the filesystem time to delete them before continuing   
1342    while ((-e "plot.log") or (-e "plot.plt") or (-e "plot.png") or (glob('*.xml.tmp'))) {
1343        sleep .5;
1344    }
1345}
1346#------------------------------------------------------------------
1347sub plotit {  #call the external plotter to create a graph (if we are in the appropriate mode)
1348       
1349    #do this unless: monitor is disabled in gui, or running standalone mode without config setting to turn on plotting     
1350    unless ((($gui == 1) and ($monitorenabledchkbx eq 'monitor_off')) or (($gui == 0) and ($config{standaloneplot} ne 'on'))) {
1351        unless ($graphtype eq 'nograph') {  #do this unless its being called from the gui with No Graph set
1352            if ($config{gnuplot}) {  #if gnuplot is specified in config.xml, use it
1353                system "$config{gnuplot}", "plot.plt";  #plot it with gnuplot
1354            }
1355            elsif (($^O eq 'MSWin32') and (-e './wgnupl32.exe')) {  #check for Win32 exe
1356                system "wgnupl32.exe", "plot.plt";  #plot it with gnuplot using exe
1357            }
1358            elsif ($gui == 1) {
1359                gui_no_plotter_found();  #if gnuplot not specified, notify on gui
1360            }
1361        }
1362    }
1363}
1364#------------------------------------------------------------------
1365sub getdirname {  #get the directory webinject engine is running from
1366       
1367    $dirname = $0;   
1368    $dirname =~ s~(.*/).*~$1~;  #for nix systems
1369    $dirname =~ s~(.*\\).*~$1~; #for windoz systems   
1370    if ($dirname eq $0) {
1371        $dirname = './';
1372    }
1373}   
1374#------------------------------------------------------------------
1375sub getoptions {  #command line options
1376       
1377    Getopt::Long::Configure('bundling');
1378    GetOptions(
1379        'v|V|version'   => \$opt_version,
1380        'c|config=s'    => \$opt_configfile,
1381        'o|output=s'    => \$opt_output,
1382        'n|no-output'   => \$nooutput,
1383        )
1384        or do {
1385            print_usage();
1386            exit();
1387        };
1388    if ($opt_version) {
1389        print "WebInject version $version\nFor more info: http://www.webinject.org\n";
1390        exit();
1391    }
1392    sub print_usage {
1393        print <<EOB
1394    Usage:
1395      webinject.pl [-c|--config config_file] [-o|--output output_location] [-n|--no-output] [testcase_file [XPath]]
1396      webinject.pl --version|-v
1397EOB
1398    }
1399}
1400#------------------------------------------------------------------
Note: See TracBrowser for help on using the repository browser.