From 30cec9d5d70535d7a30029a3854adbcf8019b13a Mon Sep 17 00:00:00 2001
From: tetragon <tetragon@4979c152-3d1c-0410-bac9-87ea11338e46>
Date: Wed, 8 Nov 2006 02:18:15 +0000
Subject: Fix edge cases of redirect whitelisting

git-svn-id: https://ledger-smb.svn.sourceforge.net/svnroot/ledger-smb/trunk@495 4979c152-3d1c-0410-bac9-87ea11338e46
---
 bin/am.pl | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

(limited to 'bin/am.pl')

diff --git a/bin/am.pl b/bin/am.pl
index d1c3260d..ea356dbf 100755
--- a/bin/am.pl
+++ b/bin/am.pl
@@ -3186,6 +3186,7 @@ sub process_transactions {
 
 sub print_recurring {
   my ($pt, $defaultprinter) = @_;
+  use List::Util qw(first);
 
   my %f = &formnames;
   my $ok = 1;
@@ -3203,7 +3204,7 @@ sub print_recurring {
       @a = ("perl", "$form->{script}", "action=reprint&module=$form->{module}&type=$form->{type}&login=$form->{login}&path=$form->{path}&sessionid=$form->{sessionid}&id=$form->{id}&formname=$f[$j]&format=$f[$j+1]&media=$media&vc=$form->{vc}&ARAP=$form->{ARAP}");
 
       $form->error($locale->text('Invalid redirect')) unless
-        grep {/$form->{script}/} @{LedgerSMB::Sysconfig::scripts};
+        first {$_ eq $form->{script}} @{LedgerSMB::Sysconfig::scripts};
       $ok = !(system(@a));
       
       if ($ok) {
@@ -3222,6 +3223,7 @@ sub print_recurring {
 
 sub email_recurring {
   my ($pt) = @_;
+  use List::Util qw(first);
 
   my %f = &formnames;
   my $ok = 1;
@@ -3244,7 +3246,7 @@ sub email_recurring {
       @a = ("perl", "$form->{script}", "action=reprint&module=$form->{module}&type=$form->{type}&login=$form->{login}&path=$form->{path}&sessionid=$form->{sessionid}&id=$form->{id}&formname=$f[$j]&format=$f[$j+1]&media=email&vc=$form->{vc}&ARAP=$form->{ARAP}&message=$message");
 
       $form->error($locale->text('Invalid redirect')) unless
-        grep {/$form->{script}/} @{LedgerSMB::Sysconfig::scripts};
+        first {$_ eq $form->{script}} @{LedgerSMB::Sysconfig::scripts};
       $ok = !(system(@a));
       
       if ($ok) {
-- 
cgit v1.2.3