Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

Merge branch 'master' of ssh://git.icdevgroup.org/var/git/interchange

  • Loading branch information...
commit 60a4731e5a5db9504fd2448eee1be46b674173b0 2 parents 613b1fc + be63373
Gert van der Spoel authored
View
7 code/Widget/uploadhelper.widget
@@ -16,6 +16,7 @@ sub {
my $name = $opt->{name};
my $val = $opt->{value};
+ my $umask = $opt->{umask} || '022';
my $path = $opt->{path} || $opt->{outboard};
my $size = $opt->{cols} || $opt->{width};
@@ -37,11 +38,13 @@ sub {
}
$out .= qq{&nbsp;<INPUT TYPE=file NAME="$name" VALUE="$val">
<INPUT TYPE=hidden NAME="ui_upload_file_path:$name" VALUE="$path">
-<INPUT TYPE=hidden NAME="$name" VALUE="$val">};
+<INPUT TYPE=hidden NAME="$name" VALUE="$val">
+<INPUT TYPE=hidden NAME="ui_upload_umask:$name" VALUE="$umask">};
}
else {
$out = qq{<INPUT TYPE=hidden NAME="ui_upload_file_path:$name" VALUE="$path">
-<INPUT TYPE=file NAME="$name"$size>};
+<INPUT TYPE=file NAME="$name"$size>
+<INPUT TYPE=hidden NAME="ui_upload_umask:$name" VALUE="$umask">};
}
return $out;
}
View
5 dist/lib/UI/pages/admin/upload_file.html
@@ -89,6 +89,9 @@
<INPUT NAME=ui_upload_ascii TYPE=radio VALUE=0>&nbsp;[L]Binary[/L]
[/else]
[/if]
+ <BR>
+ [L]Umask default (022)[/L]&nbsp;<INPUT NAME=ui_upload_umask TYPE=text VALUE='022' size=10>
+ <BR>
</BLOCKQUOTE>
<P>
<B>[L]Backup mode[/L]</B>
@@ -124,7 +127,7 @@
$regex = q{@_UI_CONST_IMAGE_REGEX_@} || '\.(?:gif|jpe?g|png)$';
if( $CGI->{ui_upload_fn} =~ m{$regex}i) {
- $CGI->{ui_upload_umask} = '022';
+ $CGI->{ui_upload_umask} ||= '022';
}
return;
[/calc]
View
6 dist/lib/UI/profiles/process_filter
@@ -98,9 +98,13 @@ __NAME__ process_filter
$fn =~ s,.*\\,,;
$fn = $Tag->filter('filesafe', $fn);
#Debug("cgi->$key now='$CGI->{$key}'");
+
+ my $umaskkey = 'ui_upload_umask:' . $key;
+ my $umask = $CGI->{$umaskkey};
+
$CGI->{$key} = $fn;
my $out = "$path/$fn";
- unless ($Tag->value_extended( { name => $key, outfile => $out , yes => 1} ) ) {
+ unless ($Tag->value_extended( { name => $key, outfile => $out , yes => 1, umask => $umask} ) ) {
$Scratch->{ui_failure} .= "\nFailed to write upload file $out";
}
}
View
1  dist/lib/UI/vars/UI_STD_HEAD
@@ -1,5 +1,6 @@
## UI Header vars, version: $Id: UI_STD_HEAD,v 2.45 2009-01-06 20:26:26 racke Exp $
Variable UI_STD_INIT <<EOV
+[tag pragma url_no_session_id 0][/tag]
[calcn]
# is this browser able to grok DHTML ?
# (Called separately to prevent bad user value in MV_DHTML_BROWSER
View
1  lib/Vend/Order.pm
@@ -126,6 +126,7 @@ my %Parse = (
my($ref,$params) = @_;
my ($var, $value) = split /\s+/, $params, 2;
$::Values->{$var} = $value;
+ return 1;
},
'&setcheck' => sub {
my($ref,$params) = @_;
View
86 lib/Vend/Server.pm
@@ -127,26 +127,37 @@ sub populate {
# try to get originating host's IP address if request was
# forwarded through a trusted proxy
- my $ip;
- if ($Global::TrustProxy
- and ($CGI::remote_addr =~ $Global::TrustProxy
- or $CGI::remote_host =~ $Global::TrustProxy)
- and $ip = $cgivar->{HTTP_X_FORWARDED_FOR}) {
- # trust only the last hop's IP address before our trusted proxy
- # when multiples are present in a comma-separated list
- $ip =~ s/.*,//;
- $ip =~ s/^\s+//; $ip =~ s/\s+$//;
- if ($ip =~ /^\d\d?\d?\.\d\d?\d?\.\d\d?\d?\.\d\d?\d?$/) {
+ if (
+ $Global::TrustProxy
+ and (
+ $CGI::remote_addr =~ $Global::TrustProxy
+ or $CGI::remote_host =~ $Global::TrustProxy
+ )
+ and my $forwarded_for = $cgivar->{HTTP_X_FORWARDED_FOR}
+ ) {
+ # multiple source IP addresses may appear in X-Forwarded-For header
+ # in a comma-separated list
+ for my $ip (reverse grep /\S/, split /\s*,\s*/, $forwarded_for) {
+ # do we have a valid-looking IP address?
+ if ($ip !~ /^\d\d?\d?\.\d\d?\d?\.\d\d?\d?\.\d\d?\d?$/) {
+ # if not, log error and ignore X-Forwarded-For header
+ ::logGlobal(
+ { level => 'info' },
+ "Unknown X-Forwarded-For header set from trusted proxy %s: %s",
+ $CGI::remote_addr,
+ $forwarded_for,
+ );
+ last;
+ }
+
+ # skip any other upstream trusted proxies
+ next if $ip =~ $Global::TrustProxy;
+
+ # rightmost IP address that's not a trusted proxy is the customer IP
+ # address as far as we're concerned, so keep that and exit loop
$CGI::remote_addr = $ip;
undef $CGI::remote_host;
- }
- else {
- ::logGlobal(
- { level => 'info' },
- "Unknown HTTP_X_FORWARDED_FOR header set from trusted proxy %s: '%s'",
- $CGI::remote_addr,
- $cgivar->{HTTP_X_FORWARDED_FOR},
- );
+ last;
}
}
}
@@ -467,12 +478,12 @@ sub parse_multipart {
}
#::logDebug("Content-Disposition: " . $header{'Content-Disposition'});
- my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]*)"?/;
+ my($param)= $header{'Content-Disposition'}=~/ name="?([^\";]+)"?/;
# Bug: Netscape doesn't escape quotation marks in file names!!!
my($filename) = $header{'Content-Disposition'}=~/ filename="?([^\";]*)"?/;
#::logDebug("param='$param' filename='$filename'" );
- if(! $param) {
+ if(not defined $param) {
::logGlobal({ level => 'debug' }, "unsupported multipart header: \n%s\n", $header);
next;
}
@@ -564,6 +575,25 @@ sub canon_status {
return "$_\r\n";
}
+sub get_cache_headers {
+ my @headers;
+
+ my $cc = $::Pragma->{cache_control};
+ push @headers, "Cache-Control: $cc" if $cc;
+
+ push @headers, "Pragma: no-cache" if delete $::Scratch->{mv_no_cache};
+
+ return @headers;
+}
+
+sub add_cache_headers {
+ return unless my @headers = get_cache_headers();
+
+ $Vend::StatusLine .= "\r\n" unless $Vend::StatusLine =~ /\n\z/;
+ $Vend::StatusLine .= "$_\r\n" for @headers;
+ return 1;
+}
+
sub respond {
# $body is now a reference
my ($s, $body) = @_;
@@ -625,8 +655,9 @@ sub respond {
$Vend::StatusLine .= "X-Track: " . $Vend::Track->header() . "\r\n"
if $Vend::Track and $Vend::Cfg->{UserTrack};
# END TRACK
- $Vend::StatusLine .= "Pragma: no-cache\r\n"
- if delete $::Scratch->{mv_no_cache};
+
+ add_cache_headers();
+
print MESSAGE canon_status($Vend::StatusLine);
print MESSAGE "\r\n";
print MESSAGE $$body;
@@ -674,9 +705,10 @@ sub respond {
select $save;
$Vend::StatusLine .= "\r\nX-Track: " . $Vend::Track->header() . "\r\n"
if $Vend::Track and $Vend::Cfg->{UserTrack};
-# END TRACK
- $Vend::StatusLine .= "Pragma: no-cache\r\n"
- if delete $::Scratch->{mv_no_cache};
+# END TRACK
+
+ add_cache_headers();
+
$status = '200 OK' if ! $status;
if(defined $Vend::StatusLine) {
$Vend::StatusLine = "HTTP/1.0 $status\r\n$Vend::StatusLine"
@@ -744,8 +776,8 @@ sub respond {
if $Vend::Track and $Vend::Cfg->{UserTrack};
# END TRACK
}
- print $fh canon_status("Pragma: no-cache")
- if delete $::Scratch->{mv_no_cache};
+
+ print $fh canon_status($_) for get_cache_headers();
print $fh "\r\n";
print $fh $$body;
View
109 lib/Vend/UserDB.pm
@@ -46,32 +46,74 @@ if ($@) {
::logGlobal("SHA1 passwords disabled: $@");
}
+# The object encryption methods take three arguments: object, password, and
+# mystery meat. If called in the context of new_account(), the mystery meat
+# is the salt (which is not always used). If called in the context of
+# login(), then the mystery meat is the entire password field from the
+# database (with salt, if applicable).
my %enc_subs = (
- default => sub {
- my $obj = shift;
- my ($pwd, $salt) = @_;
- return crypt($pwd, $salt);
- },
- md5 => sub {
- my $obj = shift;
- return Digest::MD5::md5_hex(shift);
- },
- sha1 => sub {
- my $obj = shift;
- unless ($HAVE_SHA1) {
- $obj->log_either('SHA1 passwords unavailable. Is Digest::SHA1 installed?');
- return;
- }
- return Digest::SHA1::sha1_hex(shift);
- },
+ default => \&enc_default,
+ md5 => \&enc_md5,
+ md5_salted => \&enc_md5_salted,
+ sha1 => \&enc_sha1,
);
+sub enc_default {
+ my $obj = shift;
+ my ($pwd, $salt) = @_;
+ return crypt($pwd, $salt);
+}
+
+sub enc_md5 {
+ my $obj = shift;
+ return Digest::MD5::md5_hex(shift);
+}
+
+# This particular md5_salted encryption stores the salt with the password
+# in colon-separated format: /.+:(..)/. It is compatible with Zen Cart.
+# Detecting context based on the length of the mystery meat is a little
+# hokey; it would be more ideal to specify or detect the context
+# explicitly in/from the object itself (or as a named/separate parameter).
+sub enc_md5_salted {
+ my ($obj, $password, $mystery_meat) = @_;
+
+ my $encrypted;
+ my $return_salt;
+ my $mystery_meat_length = length $mystery_meat;
+ if ($mystery_meat_length == 35) {
+ # Extract only the salt; we don't need the database password here.
+ my (undef, $db_salt) = split(':', $mystery_meat);
+ $encrypted = Digest::MD5::md5_hex($db_salt . $password);
+ $return_salt = $db_salt;
+ }
+ else {
+ if ($mystery_meat_length != 2) {
+ # Assume the mystery meat is a salt and soldier on anyway.
+ ::logError("Unrecognized salt for md5_salted encryption.");
+ }
+ $return_salt = $mystery_meat;
+ $encrypted = Digest::MD5::md5_hex($return_salt . $password);
+ }
+
+ return "$encrypted:$return_salt";
+}
+
+sub enc_sha1 {
+ my $obj = shift;
+ unless ($HAVE_SHA1) {
+ $obj->log_either('SHA1 passwords unavailable. Is Digest::SHA1 installed?');
+ return;
+ }
+ return Digest::SHA1::sha1_hex(shift);
+}
+
# 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.
my %enc_id = qw/
13 default
32 md5
+ 35 md5_salted
40 sha1
/;
@@ -1472,6 +1514,13 @@ sub login {
if ($self->{CRYPT}) {
$self->{PASSWORD} = $self->do_crypt($pw, $db_pass);
}
+ 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}));
@@ -1655,26 +1704,36 @@ sub change_pass {
}
eval {
+ # Create copies so that ignore_case doesn't lc the originals.
+ my $vend_username = $Vend::username;
+ my $cgi_mv_username = $CGI::values{mv_username};
+ if ($self->{OPTIONS}{ignore_case}) {
+ $vend_username = lc $vend_username;
+ $cgi_mv_username = lc $cgi_mv_username
+ if defined $cgi_mv_username;
+ }
+
+ # Database operations still use the mixed-case original.
my $super = $Vend::superuser || (
$Vend::admin and
$self->{DB}->field($Vend::username, $self->{LOCATION}{SUPER})
);
- if ($self->{USERNAME} ne $Vend::username or
- defined $CGI::values{mv_username} and
- $self->{USERNAME} ne $CGI::values{mv_username}
+ if ($self->{USERNAME} ne $vend_username or
+ defined $cgi_mv_username and
+ $self->{USERNAME} ne $cgi_mv_username
) {
if ($super) {
- if ($CGI::values{mv_username} and
- $CGI::values{mv_username} ne $self->{USERNAME}) {
+ if ($cgi_mv_username and
+ $cgi_mv_username ne $self->{USERNAME}) {
$original_self = $self;
- $options{username} = $CGI::values{mv_username};
+ $options{username} = $cgi_mv_username;
undef $self;
}
} else {
errmsg("Unprivileged user '%s' attempted to change password of user '%s'",
- $Vend::username, $self->{USERNAME}) if $options{log};
- die errmsg("You are not allowed to change another user's password.") . "\n";
+ $vend_username, $self->{USERNAME}) if $options{log};
+ die errmsg("You are not allowed to change another user's password.");
}
}
Please sign in to comment.
Something went wrong with that request. Please try again.