[interchange] Fallback to credentials without sandbox_ prefix and fail properly if credentials are incomplete.

commit ad24c87a3b9c86af5488ba434a9a97a9fc37488a
Author: Stefan Hornburg (Racke) <[email protected]>
Date:   Thu Apr 12 09:59:22 2012 +0200

    Fallback to credentials without sandbox_ prefix and fail properly if credentials are incomplete.

 code/SystemTag/image.tag          |    1 +
 debian/changelog                  |    2 +-
 lib/Vend/Menu.pm                  |   15 ++++++++
 lib/Vend/Payment/PaypalExpress.pm |   26 ++++++++++----
 lib/Vend/Payment/Worldpay.pm      |   12 +++---
 lib/Vend/UserDB.pm                |   70 ++++++++++++++++++++++++++++++++----
 6 files changed, 104 insertions(+), 22 deletions(-)
---
diff --git a/code/SystemTag/image.tag b/code/SystemTag/image.tag
index 7512f88..11ec1ab 100644
--- a/code/SystemTag/image.tag
+++ b/code/SystemTag/image.tag
@@ -136,6 +136,7 @@ sub {
 				@trylist = ($try);
 			}
 			for (@trylist) {
+Log("Id $id Dir $dr Loop $_.");
 				if ($id and m{^[^/]}) {
 					if ($opt->{force} or ($dr and -f "$dr$id/$_")) {
 						$image = $_;
diff --git a/debian/changelog b/debian/changelog
index 9c18e74..76d0882 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,4 +1,4 @@
-interchange (5.7.7-2) unstable; urgency=low
+interchange (5.7.7-2.1) unstable; urgency=low
   
   * Remove superfluous space before question mark from Debconf template
     (Closes: #584513, thanks to Helge Kreutzmann <[email protected]>
diff --git a/lib/Vend/Menu.pm b/lib/Vend/Menu.pm
index adb3449..5e32574 100644
--- a/lib/Vend/Menu.pm
+++ b/lib/Vend/Menu.pm
@@ -57,6 +57,21 @@ my %transform = (
 		}
 		return 1;
 	},
+	first_line => sub {
+		my ($row, $fields) = @_;
+		return undef if ref($fields) ne 'ARRAY';
+		return 1 if $first_line;
+		my $status;
+		for(@$fields) {
+			if(s/^!\s*//) {
+				$status = $status && ! $row->{$_};
+			}
+			else {
+				$status = $status && $row->{$_};
+			}
+		}
+		return $first_line = $status;
+	},
 	last_line => sub {
 		my ($row, $fields) = @_;
 #::logDebug("last_line transform, last_line=$last_line");
diff --git a/lib/Vend/Payment/PaypalExpress.pm b/lib/Vend/Payment/PaypalExpress.pm
index 3af3763..1173d57 100644
--- a/lib/Vend/Payment/PaypalExpress.pm
+++ b/lib/Vend/Payment/PaypalExpress.pm
@@ -526,13 +526,25 @@ sub paypalexpress {
 	   $account     =~ s/getbalance_//;
 	   $account     .= '_' if length $account;
 	   $sandbox     = "sandbox." if $account =~ /sandbox/;
-	my $username    = charge_param($account . 'id') or die "Bad credentials" unless length $sandbox;
-	   $username	= charge_param('sandbox_id') if length $sandbox;
-	my $password    = charge_param($account . 'password') or die "Bad credentials" unless length $sandbox;
-	   $password	= charge_param('sandbox_password') if length $sandbox;
-	my $signature   = charge_param($account . 'signature') or die "Bad credentials" unless length $sandbox; # use this as certificate is broken
-	   $signature	= charge_param('sandbox_signature') if length $sandbox;
+    my ($username, $password, $signature);
+    if (length $sandbox && charge_param('sandbox_id')) {
+        $username   = charge_param('sandbox_id');
+        $password   = charge_param('sandbox_password');
+        $signature  = charge_param('sandbox_signature');
+    }
+    else {
+        $username    = charge_param($account . 'id');
+        $password    = charge_param($account . 'password');
+        $signature   = charge_param($account . 'signature');
+    }
 
+    unless ($username && $password && $signature) {
+         return (
+			MStatus => 'failure-hard',
+			MErrMsg => errmsg('Bad credentials'),
+		);
+    }
+    
 	my $ppcheckreturn = $::Values->{'ppcheckreturn'} || 'ord/checkout';
 	my $checkouturl = $::Tag->area({ href => "$ppcheckreturn" });
 #::logDebug("PP".__LINE__.": req=$pprequest; sandbox=$sandbox;");
diff --git a/lib/Vend/Payment/Worldpay.pm b/lib/Vend/Payment/Worldpay.pm
index 05534cd..3dd51f4 100644
--- a/lib/Vend/Payment/Worldpay.pm
+++ b/lib/Vend/Payment/Worldpay.pm
@@ -176,7 +176,7 @@ Worldpay will suck the wpcallback page back to their server and display it for y
 The page will interpolate before being sucked to Worldpay so most items such as fname lname adress fields etc are usuable on the page.
 To display banners and logos they need to be pre-loaded onto the Worldpay server
 
-At the top of the callback page just below the [charge route="worldpay" worldpayrequest="callback"] you can test for a sucessful transaction as follows:-
+At the top of the callback page just below the [charge route="worldpay" worldpayrequest="callback"] you can test for a successful transaction as follows:-
 
 [if type="cgi" term="transStatus" op="eq" compare="Y"] 
 [and type="cgi" term="callbackPW" op="eq" compare="yourcallbackpassword"] 
@@ -245,12 +245,12 @@ the Worldpay payment server. The customers details and cart is logged in the dat
 before going to Worldpay with a temporary order number of the form WPtmpUxxxx where Uxxxx
 is derived from the username counter
 
-If the transaction is sucessful the module processes the callback response from Worlday, if
-sucessfull the temporary order number is converted to an Interchange order number and a final
+If the transaction is successful the module processes the callback response from Worlday, if
+successful the temporary order number is converted to an Interchange order number and a final
 route is run to send out the report and customer emails. Cancelled transactions remain in the
 database with the temporary order numbers but are automatically archived.
 
-The module will also optionally decrement the inventory on a sucessfull transaction, if used
+The module will also optionally decrement the inventory on a successful, if used
 the inventory decrement in log transaction should be disabled by setting the appropriate variable
 
 =head1 The active settings.
@@ -308,12 +308,12 @@ standard report email title
 
 =item update_status
 
-Allows the order status to be set to any desired value after a sucessfull transaction, eg set to processing
+Allows the order status to be set to any desired value after a successful transaction, eg set to processing
 and all successfull transactions will have status processing, defaults to pending
 
 =item dec_inventory
 
-Set to 1 for module to decrement the inventory on a sucessful transaction, if used disable decrement via
+Set to 1 for module to decrement the inventory on a successful transaction, if used disable decrement via
 log_transaction.
 
 
diff --git a/lib/Vend/UserDB.pm b/lib/Vend/UserDB.pm
index e2ae946..fcb0525 100644
--- a/lib/Vend/UserDB.pm
+++ b/lib/Vend/UserDB.pm
@@ -29,13 +29,16 @@ use vars qw!
 use Vend::Data;
 use Vend::Util;
 use Vend::Safe;
+#use Safe;
 use strict;
 no warnings qw(uninitialized numeric);
 
 my $ready = new Vend::Safe;
+#my $ready = new Safe;
 
 my $HAVE_SHA;
 
+
 eval {
     require Digest::SHA;
     import Digest::SHA;
@@ -56,6 +59,7 @@ my %enc_subs = (
     md5 => \&enc_md5,
     md5_salted => \&enc_md5_salted,
     sha1 => \&enc_sha1,
+    sha256 => \&enc_sha256,
 );
 
 sub enc_default {
@@ -107,6 +111,33 @@ sub enc_sha1 {
     return Digest::SHA::sha1_hex(shift);
 }
 
+sub enc_sha256 {
+    my ($obj, $password, $mystery_meat, $sha256Id) = @_;
+    unless ($sha256Id) {$sha256Id = '6';}
+    unless ($HAVE_SHA) {
+        $obj->log_either('SHA passwords unavailable. Is Digest::SHA installed?');
+        return;
+    }
+    my $encrypted;
+    my $return_salt;
+    my $mystery_meat_length = length $mystery_meat;
+    if ($mystery_meat_length == 98){
+    	    # Extract only the salt; we don't need the database password here.
+    	    my (undef, undef, $db_salt) = split('\$', $mystery_meat);
+    	    return crypt($password, '$'.$sha256Id.'$'.$db_salt );
+    	    $return_salt = $db_salt;
+    }else{
+        if ($mystery_meat_length != 8) {
+            # Assume the mystery meat is a salt and soldier on anyway.
+            ::logError("Unrecognized salt for sha256 encryption.");
+        }
+        $return_salt = $mystery_meat;
+        return crypt($password, '$'.$sha256Id.'$'.$return_salt );
+    }
+    return '$'.$sha256Id.'$'.$return_salt.'$'.$encrypted;
+}
+
+
 # Maps the length of the encrypted data to the algorithm that
 # produces it. This method will have to be re-evaluated if competing
 # algorithms are introduced which produce the same-length value.
@@ -115,6 +146,7 @@ my %enc_id = qw/
     32  md5
     35  md5_salted
     40  sha1
+    95  sha256
 /;
 
 =head1 NAME
@@ -1472,13 +1504,16 @@ sub login {
 			if ( $self->{CRYPT} && $self->{OPTIONS}{promote} ) {
 				my ($cur_method) = grep { $self->{OPTIONS}{ $_ } } keys %enc_subs;
 				$cur_method ||= 'default';
+				::logError("Current method is $cur_method.");
 
 				my $stored_by = $enc_id{ length($db_pass) };
-
+			::logError("Stored by is " . $stored_by || 'N/A');
 				if (
 					$cur_method ne $stored_by
-					&&
-					$db_pass eq $enc_subs{$stored_by}->($self, $pw, $db_pass)
+						    &&
+				        ((! $stored_by && $db_pass eq $pw)
+					 ||
+					 ($db_pass eq $enc_subs{$stored_by}->($self, $pw, $db_pass)))
 				) {
 
 					my $newpass = $enc_subs{$cur_method}->($self, $pw, $db_pass);
@@ -1517,10 +1552,12 @@ sub login {
 			else {
 				$db_pass = lc $db_pass if $self->{OPTIONS}{ignore_case};
 			}
+			
 #::logDebug(errmsg("crypt: %s", $self->{CRYPT}));
 #::logDebug(errmsg("ignore_case: %s", $self->{OPTIONS}{ignore_case}));
 #::logDebug(errmsg("given password: %s", $self->{PASSWORD}));
 #::logDebug(errmsg("stored password: %s", $db_pass));
+
 			unless ($self->{PASSWORD} eq $db_pass) {
 				$self->log_either(errmsg("Denied attempted login by user '%s' with incorrect password",
 					$self->{USERNAME}));
@@ -1762,9 +1799,18 @@ sub change_pass {
 			unless $self->{PASSWORD} eq $self->{VERIFY};
 
 		if ( $self->{CRYPT} ) {
+			
+			my ($cur_method) = grep { $self->{OPTIONS}{ $_ } } keys %enc_subs;
+			$cur_method ||= 'default';
+			my $salt_length;
+			if ($cur_method eq 'sha256'){
+				$salt_length = 8
+			}else{
+				$salt_length = 2
+			}
 			$self->{PASSWORD} = $self->do_crypt(
 				$self->{PASSWORD},
-				Vend::Util::random_string(2),
+				Vend::Util::random_string($salt_length),
 			);
 		}
 		
@@ -1872,8 +1918,16 @@ sub new_account {
 
 		my $pw = $self->{PASSWORD};
 		if($self->{CRYPT}) {
+			my ($cur_method) = grep { $self->{OPTIONS}{ $_ } } keys %enc_subs;
+			$cur_method ||= 'default';
+			my $salt_length;
+			if ($cur_method eq 'sha256'){
+				$salt_length = 8
+			}else{
+				$salt_length = 2
+			}
 			eval {
-				$pw = $self->do_crypt($pw, Vend::Util::random_string(2));
+				$pw = $self->do_crypt($pw, Vend::Util::random_string($salt_length));
 			};
 		}
 	
@@ -2276,8 +2330,8 @@ sub userdb {
 }
 
 sub do_crypt {
-	my ($self, $password, $salt) = @_;
-	my $sub = $self->{ENCSUB};
+	my ($self, $password, $salt, $sha256Id) = @_;
+	my $sub = $self->{ENCSUB}; 
 	unless ($sub) {
 		for (grep { $self->{OPTIONS}{$_} } keys %enc_subs) {
 			$sub = $enc_subs{$_};
@@ -2285,7 +2339,7 @@ sub do_crypt {
 		}
 		$self->{ENCSUB} = $sub ||= $enc_subs{default};
 	}
-	return $sub->($self, $password, $salt);
+	return $sub->($self, $password, $salt, $sha256Id);
 }
 
 1;