Adjust MySQL key lengths to 191 characters
[interchange.git] / lib / Vend / Payment.pm
1 # Vend::Payment - Interchange payment processing routines
2 #
3 # Copyright (C) 2002-2017 Interchange Development Group
4 # Copyright (C) 1996-2002 Red Hat, Inc.
5 #
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # (at your option) any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14 # GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public
17 # License along with this program; if not, write to the Free
18 # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston,
19 # MA  02110-1301  USA.
20
21 package Vend::Payment;
22 require Exporter;
23
24 $VERSION = '2.24';
25
26 @ISA = qw(Exporter);
27
28 @EXPORT = qw(
29                                 charge
30                                 charge_param
31                 );
32
33 @EXPORT_OK = qw(
34                                 map_actual
35                 );
36
37 use Vend::Util;
38 use Vend::Interpolate;
39 use Vend::Order;
40 use IO::Pipe;
41 use strict;
42
43 use vars qw/$Have_LWP $Have_Net_SSLeay $Global_Timeout/;
44
45 my $pay_opt;
46
47 my %cyber_remap = (
48         qw/
49                 configfile CYBER_CONFIGFILE
50         id         CYBERCASH_ID
51         mode       CYBER_MODE
52         host       CYBER_HOST
53         port       CYBER_PORT
54         remap      CYBER_REMAP
55         currency   CYBER_CURRENCY
56         precision  CYBER_PRECISION
57         /
58 );
59
60 my %ignore_mv_payment = (
61         qw/
62                 gateway 1
63         /
64 );
65
66 sub charge_param {
67         my ($name, $value, $mode) = @_;
68         my $opt;
69
70         if($mode) {
71                 $opt = $Vend::Cfg->{Route_repository}{$mode} ||= {};
72         }
73         else {
74                 $opt = $pay_opt ||= {};
75         }
76
77         if($name =~ s/^mv_payment_//i) {
78                 $name = lc $name;
79         }
80
81         if(defined $value) {
82                 return $pay_opt->{$name} = $value;
83         }
84
85         # Find if set in route or options
86         return $opt->{$name}            if defined $opt->{$name};
87
88         # "gateway" and possibly other future options
89         return undef if $ignore_mv_payment{$name};
90
91         # Now check Variable space as last resort
92         my $uname = "MV_PAYMENT_\U$name";
93
94         return $::Variable->{$uname} if defined $::Variable->{$uname};
95         return $::Variable->{$cyber_remap{$name}}
96                 if defined $::Variable->{$cyber_remap{$name}};
97         return undef;
98 }
99
100 # Do remapping of payment variables submitted by user
101 # Can be changed/extended with remap/MV_PAYMENT_REMAP
102 sub map_actual {
103         my ($vref, $cref) = (@_);
104         $vref = $::Values               unless $vref;
105         $cref = \%CGI::values   unless $cref;
106         my @map = qw(
107                 address
108                 address1
109                 address2
110                 amount
111                 b_address
112                 b_address1
113                 b_address2
114                 b_city
115                 b_country
116                 b_company
117                 b_fname
118                 b_lname
119                 b_name
120                 b_phone
121                 b_state
122                 b_zip
123                 check_account
124                 check_acctname
125                 check_accttype
126                 check_bankname
127                 check_checktype
128                 check_dl
129                 check_magstripe
130                 check_number
131                 check_routing
132                 check_transit
133                 city
134                 comment1
135                 comment2
136                 corpcard_type
137                 country
138                 cvv2
139                 email
140                 company
141                 fname
142                 item_code
143                 item_desc
144                 lname
145                 mv_credit_card_cvv2
146                 mv_credit_card_exp_month
147                 mv_credit_card_exp_year
148                 mv_credit_card_number
149                 mv_order_number
150                 mv_transaction_id
151                 name
152                 origin_zip
153                 phone
154                 phone_day
155                 phone_night
156                 pin
157                 po_number
158                 salestax
159                 shipping
160                 state
161                 tax_duty
162                 tax_exempt
163                 tender
164                 zip
165         );
166
167         my %map = qw(
168                 cyber_mode               mv_cyber_mode
169                 comment                  giftnote
170         );
171         @map{@map} = @map;
172
173         # Allow remapping of the variable names
174         my $remap;
175         if( $remap      = charge_param('remap') ) {
176                 $remap =~ s/^\s+//;
177                 $remap =~ s/\s+$//;
178                 my (%remap) = split /[\s=]+/, $remap;
179                 for (keys %remap) {
180                         $map{$_} = $remap{$_};
181                 }
182         }
183
184         my %actual;
185         my $key;
186
187         my %billing_set;
188         my @billing_set = qw/
189                                                         b_address1
190                                                         b_address2
191                                                         b_address3
192                                                         b_city
193                                                         b_state
194                                                         b_zip
195                                                         b_country
196                                                 /;
197
198         my @billing_ind = qw/
199                                                         b_address1
200                                                         b_city
201                                                 /;
202
203         if(my $str = $::Variable->{MV_PAYMENT_BILLING_SET}) {
204                 @billing_set = grep $_ !~ /\W/, split /[\s,\0]+/, $str;
205         }
206         if(my $str = $::Variable->{MV_PAYMENT_BILLING_INDICATOR}) {
207                 @billing_ind = grep $_ !~ /\W/, split /[\s,\0]+/, $str;
208         }
209
210         @billing_set{@billing_set} = @billing_set;
211
212         my $no_billing_xfer = 1;
213
214         for(@billing_ind) {
215                 $no_billing_xfer = 0  unless length($vref->{$_});
216         }
217
218         # pick out the right values, need alternate billing address
219         # substitution
220         foreach $key (keys %map) {
221                 $actual{$key} = $vref->{$map{$key}} || $cref->{$key};
222                 my $secondary = $key;
223                 next unless $secondary =~ s/^b_//;
224                 if ($billing_set{$key}) {
225                         next if $no_billing_xfer;
226                         $actual{$key} = $vref->{$secondary};
227                         next;
228                 }
229                 next if $actual{$key};
230                 $actual{$key} = $vref->{$map{$secondary}} || $cref->{$map{$secondary}};
231         }
232
233         $actual{name}            = "$actual{fname} $actual{lname}"
234                 if $actual{lname};
235         $actual{b_name}          = "$actual{b_fname} $actual{b_lname}"
236                 if $actual{b_lname};
237         if($actual{b_address1}) {
238                 $actual{b_address} = "$actual{b_address1}";
239                 $actual{b_address} .=  ", $actual{b_address2}"
240                         if $actual{b_address2};
241         }
242         if($actual{address1}) {
243                 $actual{address} = "$actual{address1}";
244                 $actual{address} .=  ", $actual{address2}"
245                         if $actual{address2};
246         }
247
248         # Do some standard processing of credit card expirations
249         $actual{mv_credit_card_exp_month} =~ s/\D//g;
250         $actual{mv_credit_card_exp_month} =~ s/^0+//;
251         $actual{mv_credit_card_exp_year} =~ s/\D//g;
252         $actual{mv_credit_card_exp_year} =~ s/\d\d(\d\d)/$1/;
253
254         $actual{mv_credit_card_reference} = $actual{mv_credit_card_number} =~ s/\D//g;
255         $actual{mv_credit_card_reference} =~ s/^(\d\d).*(\d\d\d\d)$/$1**$2/;
256
257     $actual{mv_credit_card_exp_all} = sprintf(
258                                         '%02d/%02d',
259                                         $actual{mv_credit_card_exp_month},
260                                         $actual{mv_credit_card_exp_year},
261                                       );
262
263         $actual{cyber_mode} = charge_param('transaction')
264                                                 ||      $actual{cyber_mode}
265                                                 || 'mauthcapture';
266         
267         return %actual;
268 }
269
270 sub gen_order_id {
271         my $opt = shift || {};
272         if( $opt->{order_id}) {
273                 # do nothing, already set
274         }
275         elsif($opt->{counter}) {
276                 $opt->{order_id} = Vend::Interpolate::tag_counter(
277                                                 $opt->{counter},
278                                                 { start => $opt->{counter_start} || 100000,
279                                                   sql   => $opt->{sql_counter},
280                                                 },
281                                         );
282         }
283         else {
284                 my(@t) = gmtime(time());
285                 my($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = @t;
286                 $opt->{order_id} = POSIX::strftime("%y%m%d%H%M%S$$", @t);
287
288         }
289
290         return $opt->{order_id};
291 }
292
293 sub charge {
294         my ($charge_type, $opt) = @_;
295
296         my $pay_route;
297
298         ### We get the payment base information from a route with the
299         ### same name as $charge_type if it is there
300         if($Vend::Cfg->{Route}) {
301                 $pay_route = $Vend::Cfg->{Route_repository}{$charge_type} || {};
302         }
303         else {
304                 $pay_route = {};
305         }
306
307         ### Then we take any payment options set in &charge, [charge ...],
308         ### or $Tag->charge
309
310         # $pay_opt is package-scoped but lexical
311         $pay_opt = { %$pay_route };
312         for(keys %$opt) {
313                 $pay_opt->{$_} = $opt->{$_};
314         }
315
316         # We relocate these to subroutines to standardize
317
318         ### Maps the form variable names to the names needed by the routine
319         ### Standard names are defined ala Interchange or MV4.0x, b_name, lname,
320         ### etc. with b_varname taking precedence for these. Falls back to lname
321         ### if the b_lname is not set
322         my (%actual) = map_actual();
323         $pay_opt->{actual} = \%actual;
324
325         # We relocate this to a subroutine to standardize. Uses the payment
326         # counter if there
327         my $orderID = gen_order_id($pay_opt);
328
329         ### Set up the amounts. The {amount} key will have the currency prepended,
330         ### e.g. "usd 19.95". {total_cost} has just the cost.
331
332         # Uses the {currency} -> MV_PAYMENT_CURRENCY options if set
333         my $currency =  charge_param('currency')
334                                         || ($Vend::Cfg->{Locale} && $Vend::Cfg->{Locale}{currency_code})
335                                         || 'usd';
336
337         # Uses the {precision} -> MV_PAYMENT_PRECISION options if set
338         my $precision = charge_param('precision') || 2;
339         my $penny     = charge_param('penny_pricing') || 0;
340
341         my $amount = $pay_opt->{amount} || Vend::Interpolate::total_cost();
342         $amount = round_to_frac_digits($amount, $precision);
343         $amount = sprintf "%.${precision}f", $amount;
344         $amount *= 100 if $penny;
345
346         $pay_opt->{total_cost} = $amount;
347         $pay_opt->{amount} = "$currency $amount";
348
349         ### 
350         ### Finish setting amounts and currency
351
352         # If we have a previous payment amount, delete it but push it on a stack
353         # 
354         my $stack = $Vend::Session->{payment_stack} || [];
355         delete $Vend::Session->{payment_result}; 
356         delete $Vend::Session->{cybercash_result}; ### Deprecated
357
358 #::logDebug("Called charge at " . scalar(localtime));
359 #::logDebug("Charge caller is " . join(':', caller));
360
361 #::logDebug("mode=$pay_opt->{gateway}");
362 #::logDebug("pay_opt=" . ::uneval($pay_opt));
363         # Default to the gateway same as charge type if no gateway specified,
364         # and set the gateway in the session for logging on completion
365         if(! $opt->{gateway}) {
366                 $pay_opt->{gateway} = charge_param('gateway') || $charge_type;
367         }
368         #$charge_type ||= $pay_opt->{gateway};
369         $Vend::Session->{payment_mode} = $pay_opt->{gateway};
370
371         # See if we are in test mode
372         $pay_opt->{test} = charge_param('test');
373
374         # just convenience
375         my $gw = $pay_opt->{gateway};
376
377         # See if we are calling a defined GlobalSub payment mode
378         my $sub = $Global::GlobalSub->{$gw};
379
380         # Try our predefined modes
381         if (! $sub and defined &{"Vend::Payment::$gw"} ) {
382                 $sub = \&{"Vend::Payment::$gw"};
383         }
384
385         # This is the return from all routines
386         my %result;
387
388         if($sub) {
389 #::logDebug("Charge sub");
390                 # Calling a defined GlobalSub payment mode
391                 # Arguments are the passed option hash (if any) and the route hash
392
393         my $pid;
394         my $timeout = $pay_opt->{global_timeout} || charge_param('global_timeout');
395
396         %result = eval {
397             if ($timeout > 0) {
398
399                 my $pipe = IO::Pipe->new;
400
401                 unless ($pid = fork) {
402
403                     $pipe->writer;
404
405                     Vend::Server::sever_database();
406                     local $SIG{USR2} = sub {
407                         $Global_Timeout = 'Global Timeout on gateway request';
408                         exit;
409                     };
410
411                     my %rv = $sub->($pay_opt);
412
413                     $pipe->print( ::uneval(\%rv) );
414                     exit;
415                 }
416
417                 $pipe->reader;
418
419                 my $to_msg = charge_param('global_timeout_msg')
420                     || 'Due to technical difficulties, your order could not be processed.';
421                 local $SIG{ALRM} = sub { die "$to_msg\n" };
422
423                 alarm $timeout;
424                 wait;
425                 alarm 0;
426
427                 $pid = undef;
428
429                 my $rv = eval join ('', $pipe->getlines);
430
431                 return %$rv;
432             }
433
434             return $sub->($pay_opt);
435         };
436
437         if($@) {
438             my $msg = errmsg(
439                         "payment routine '%s' returned error: %s",
440                         $charge_type,
441                         $@,
442             );
443             kill (USR2 => $pid)
444                 if $pid && kill (0 => $pid);
445             ::logError($msg);
446             $result{MStatus} = 'died';
447             $result{MErrMsg} = $msg;
448         }
449     }
450         elsif($charge_type =~ /^\s*custom\s+(\w+)(?:\s+(.*))?/si) {
451 #::logDebug("Charge custom");
452                 # MV4 and IC4.6.x methods
453                 my (@args);
454                 @args = Text::ParseWords::shellwords($2) if $2;
455                 if(! defined ($sub = $Global::GlobalSub->{$1}) ) {
456                         ::logError("bad custom payment GlobalSub: %s", $1);
457                         return undef;
458                 }
459                 eval {
460                         %result = $sub->(@args);
461                 };
462                 if($@) {
463                         my $msg = errmsg(
464                                                 "payment routine '%s' returned error: %s",
465                                                 $charge_type,
466                                                 $@,
467                         );
468                         ::logError($msg);
469                         $result{MStatus} = $msg;
470                 }
471         }
472         elsif (
473                         $actual{cyber_mode} =~ /^minivend_test(?:_(.*))?/
474                                 or 
475                         $charge_type =~ /^internal_test(?:[ _]+(.*))?/
476                   )
477         {
478 #::logDebug("Internal test");
479
480                 # Test mode....
481
482                 my $status = $1 || charge_param('result') || undef;
483                 # Interchange test mode
484                 my %payment = ( %$pay_opt );
485                 &testSetServer ( %payment );
486                 %result = testsendmserver(
487                         $actual{cyber_mode},
488                         'Order-ID'     => $orderID,
489                         'Amount'       => $amount,
490                         'Card-Number'  => $actual{mv_credit_card_number},
491                         'Card-Name'    => $actual{b_name},
492                         'Card-Address' => $actual{b_address},
493                         'Card-City'    => $actual{b_city},
494                         'Card-State'   => $actual{b_state},
495                         'Card-Zip'     => $actual{b_zip},
496                         'Card-Country' => $actual{b_country},
497                         'Card-Exp'     => $actual{mv_credit_card_exp_all}, 
498                 );
499                 $result{MStatus} = $status if defined $status;
500         }
501         else {
502 #::logDebug("Unknown charge type");
503                 my $msg = errmsg("Unknown charge type: %s", $charge_type);
504                 ::logError($msg);
505                 $result{MStatus} = $msg;
506         }
507
508         push @$stack, \%result;
509         $Vend::Session->{payment_result} = \%result;
510         $Vend::Session->{payment_stack}  = $stack;
511
512         my $svar = charge_param('success_variable') || 'MStatus';
513         my $evar = charge_param('error_variable')   || 'MErrMsg';
514
515         if($result{$svar} !~ /^success/) {
516                 $Vend::Session->{payment_error} = $result{$evar};
517                 if ($result{$evar} =~ /\S/) {
518                         $Vend::Session->{errors}{mv_credit_card_valid} = $result{$evar};
519                 }
520                 $result{'invalid-order-id'} = delete $result{'order-id'}
521                         if $result{'order-id'};
522         }
523         elsif($result{$svar} =~ /success-duplicate/) {
524                 $Vend::Session->{payment_error} = $result{$evar};
525                 $result{'invalid-order-id'} = delete $result{'order-id'}
526                         if $result{'order-id'};
527         }
528         else {
529                 delete $Vend::Session->{payment_error};
530         }
531
532         $Vend::Session->{payment_id} = $result{'order-id'};
533
534         my $encrypt = charge_param('encrypt');
535
536         if($encrypt and $CGI::values{mv_credit_card_number} and $Vend::Cfg->{EncryptKey}) {
537                 my $prog = charge_param('encrypt_program') || $Vend::Cfg->{EncryptProgram};
538                 if($prog =~ /pgp|gpg/) {
539                         $CGI::values{mv_credit_card_force} = 1;
540                         (
541                                 undef,
542                                 $::Values->{mv_credit_card_info},
543                                 $::Values->{mv_credit_card_exp_month},
544                                 $::Values->{mv_credit_card_exp_year},
545                                 $::Values->{mv_credit_card_exp_all},
546                                 $::Values->{mv_credit_card_type},
547                                 $::Values->{mv_credit_card_error}
548                         )       = encrypt_standard_cc(\%CGI::values);
549                 }
550         }
551         ::logError(
552                                 "Order id for charge type %s: %s",
553                                 $charge_type,
554                                 $Vend::Session->{cybercash_id},
555                         )
556                 if $pay_opt->{log_to_error};
557
558         # deprecated
559         for(qw/ id error result /) {
560                 $Vend::Session->{"cybercash_$_"} = $Vend::Session->{"payment_$_"};
561         }
562
563         return \%result if $pay_opt->{hash};
564         return $result{'order-id'};
565 }
566
567 sub testSetServer {
568         my %options = @_;
569         my $out = '';
570         for(sort keys %options) {
571                 $out .= "$_=$options{$_}\n";
572         }
573         logError("Test CyberCash SetServer:\n%s\n" , $out);
574         1;
575 }
576
577 sub testsendmserver {
578         my ($type, %options) = @_;
579         my $out ="type=$type\n";
580         for(sort keys %options) {
581                 $out .= "$_=$options{$_}\n";
582         }
583         logError("Test CyberCash sendmserver:\n$out\n");
584         my $oid;
585         eval {
586                 $oid = Vend::Interpolate::tag_counter(
587                                         "$Vend::Cfg->{ScratchDir}/internal_test.payment.number"
588                                         );
589         };
590         return ('MStatus', 'success', 'order-id', $oid || 'COUNTER_FAILED');
591 }
592
593 sub post_data {
594         my ($opt, $query) = @_;
595
596         unless ($opt->{use_wget} or $Have_Net_SSLeay or $Have_LWP) {
597                 die "No Net::SSLeay or Crypt::SSLeay found.\n";
598         }
599
600         my $submit_url = $opt->{submit_url};
601         my $server;
602         my $port = $opt->{port} || 443;
603         my $script;
604         my $protocol = $opt->{protocol} || 'https';
605         if($submit_url) {
606                 $server = $submit_url;
607                 $server =~ s{^https://}{}i;
608                 $server =~ s{(/.*)}{};
609                 $port = $1 if $server =~ s/:(\d+)$//;
610                 $script = $1;
611         }
612         elsif ($opt->{host}) {
613                 $server = $opt->{host};
614                 $script = $opt->{script};
615                 $script =~ s:^([^/]):/$1:;
616                 $submit_url = join "",
617                                                 $protocol,
618                                                 '://',
619                                                 $server,
620                                                 ($port ? ":$port" : ''),
621                                                 $script,
622                                                 ;
623         }
624         my %header = ( 'User-Agent' => "Vend::Payment (Interchange version $::VERSION)");
625         if($opt->{extra_headers}) {
626                 for(keys %{$opt->{extra_headers}}) {
627                         $header{$_} = $opt->{extra_headers}{$_};
628                 }
629         }
630
631         my %result;
632         if($opt->{use_wget}) {
633                 ## Don't worry about OS independence with UNIX wget
634                 my $bdir = "$Vend::Cfg->{ScratchDir}/wget";
635
636                 unless (-d $bdir) {
637                         mkdir $bdir, 0777
638                                 or do {
639                                         my $msg = "Failed to create directory %s: %s";
640                                         $msg = errmsg($msg, $bdir, $!);
641                                         logError($msg);
642                                         die $msg;
643                                 };
644                 }
645
646                 my $filebase = "$Vend::SessionID.wget";
647                 my $statfile = Vend::File::get_filename("$filebase.stat", 1, 1, $bdir);
648                 my $outfile  = Vend::File::get_filename("$filebase.out", 1, 1, $bdir);
649                 my $infile   = Vend::File::get_filename("$filebase.in", 1, 1, $bdir);
650                 my $cmd = $opt->{use_wget} =~ m{/} ? $opt->{use_wget} : 'wget';
651
652                 my @post;
653                 while( my ($k,$v) = each %$query ) {
654                         $k = hexify($k);
655                         $v = hexify($v);
656                         push @post, "$k=$v";
657                 }
658                 my $post = join "&", @post;
659                 open WIN, "> $infile"
660                         or die errmsg("Cannot create wget post input file %s: %s", $infile, $!) . "\n";
661                 print WIN $post;
662                 local($/);
663
664                 my @args = $cmd;
665                 push @args, "--output-file=$statfile";
666                 push @args, "--output-document=$outfile";
667                 push @args, "--server-response";
668                 push @args, "--post-file=$infile";
669                 push @args, $submit_url;
670                 system @args;
671 #::logDebug("wget cmd line: " . join(" ", @args));
672                 if($?) {
673                         $result{reply_os_error} = $!;
674                         $result{reply_os_status} = $?;
675                         $result{result_page} = 'FAILED';
676                 }
677                 else {
678 #::logDebug("wget finished.");
679                         open WOUT, "< $outfile"
680                                 or die errmsg("Cannot read wget output from %s: %s", $outfile, $!) . "\n";
681                         $result{result_page} = <WOUT>;
682                         close WOUT
683                                 or die errmsg("Cannot close wget output %s: %s", $outfile, $!) . "\n";
684                         unlink $outfile unless $opt->{debug};
685                 }
686
687                 seek(WIN, 0, 0)
688                         or die errmsg("Cannot seek on wget input file %s: %s", $infile, $!) . "\n";
689                 unless($opt->{debug}) {
690                         my $len = int(length($post) / 8) + 1;
691                         print WIN 'deadbeef' x $len;
692                 }
693
694                 close WIN
695                         or die errmsg("Cannot close wget post input file %s: %s", $infile, $!) . "\n";
696                 unlink $infile unless $opt->{debug};
697                 open WSTAT, "< $statfile"
698                         or die errmsg("Cannot read wget status from %s: %s", $statfile, $!) . "\n";
699                 my $err = <WSTAT>;
700                 close WSTAT
701                         or die errmsg("Cannot close wget status %s: %s", $statfile, $!) . "\n";
702
703                 unlink $statfile unless $opt->{debug};
704                 $result{wget_output} = $err;
705                 $err =~ s/.*HTTP\s+request\s+sent,\s+awaiting\s+response[.\s]*//s;
706                 my @raw = split /\r?\n/, $err;
707                 my @head;
708                 for(@raw) {
709                         s/^\s*\d+\s*//
710                                 or last;
711                         push @head, $_;
712                 }
713                 $result{status_line} = shift @head;
714                 $result{status_line} =~ /^HTTP\S+\s+(\d+)/
715                         and $result{response_code} = $1;
716                 $result{header_string} = join "\n", @head;
717         }
718         elsif($opt->{use_net_ssleay} or ! $opt->{use_crypt_ssl} && $Have_Net_SSLeay) {
719 #::logDebug("placing Net::SSLeay request: host=$server, port=$port, script=$script");
720 #::logDebug("values: " . ::uneval($query) );
721                 my ($page, $response, %reply_headers)
722                 = post_https(
723                                            $server, $port, $script,
724                            make_headers( %header ),
725                        make_form(    %$query ),
726                                         );
727                 my $header_string = '';
728
729                 for(keys %reply_headers) {
730                         $header_string .= "$_: $reply_headers{$_}\n";
731                 }
732 #::logDebug("received Net::SSLeay header: $header_string");
733                 $result{status_line} = $response;
734                 $result{status_line} =~ /^HTTP\S+\s+(\d+)/
735                         and $result{response_code} = $1;
736                 $result{header_string} = $header_string;
737                 $result{result_page} = $page;
738         }
739         else {
740                 my @query = %{$query};
741                 my $ua = new LWP::UserAgent;
742                 my $req = POST($submit_url, \@query, %header);
743 #::logDebug("placing LWP request: " . ::uneval_it($req) );
744                 my $resp = $ua->request($req);
745                 $result{status_line} = $resp->status_line();
746                 $result{status_line} =~ /(\d+)/
747                         and $result{response_code} = $1;
748                 $result{header_string} = $resp->as_string();
749                 $result{header_string} =~ s/\r?\n\r?\n.*//s;
750 #::logDebug("received LWP header: $header_string");
751                 $result{result_page} = $resp->content();
752         }
753 #::logDebug("returning thing: " . ::uneval(\%result) );
754         return \%result;
755 }
756
757
758 1;
759 __END__