Skip to content

Commit

Permalink
Fix SQL injection vulnerability
Browse files Browse the repository at this point in the history
  • Loading branch information
@mohawk2 @andk
mohawk2 authored and andk committed Dec 29, 2014
1 parent 5dedc83 commit b05f4ad
Show file tree
Hide file tree
Showing 4 changed files with 62 additions and 55 deletions.
25 changes: 12 additions & 13 deletions bin/paused
View file
Original file line number Diff line number Diff line change
Expand Up @@ -924,25 +924,24 @@ sub timestamp { # Efficiently generate a time stamp for log files
# package mypause_daemon_inspector
sub writeback {
my($self,$hash,$hash_orig,$dbh) = @_;
my(@v,$v);
my(@v,@queryparams);
for (qw[dgot dverified ddeleted uriid
nosuccesstime nosuccesscount]) {
push @v, "$_='$hash->{$_}'" if $hash->{$_} ne $hash_orig->{$_};
next if $hash->{$_} eq $hash_orig->{$_};
push @v, "$_=?";
push @queryparams, $hash->{$_};
}
return 0 unless @v;
my $query = "UPDATE uris SET ";
$query .= join ", ", @v;
($v = $hash_orig->{uriid}) =~ s/'/\\'/g;
my $whereclause .= " WHERE uriid='$v'";
$query .= $whereclause;
my $query = "UPDATE uris SET " . join(", ", @v) . " WHERE uriid=?";
push @queryparams, $hash_orig->{uriid};
# $self->logge("Info: Going to $query");
$dbh->do($query) or $self->logge("Alert: $DBI::errstr: $query");
$dbh->do($query, undef, @queryparams) or $self->logge("Alert: $DBI::errstr: $query/(@queryparams)");
if ($DBI::errstr =~ /Non unique key|Duplicate/i) {
my $dquery = "DELETE FROM uris $whereclause";
$self->logge("Debug: Non-uniq-Error; trying: $dquery");
$dbh->do($dquery) or $self->logge("Debug: $DBI::errstr: $dquery");
$self->logge("Debug: retry now: $query");
$dbh->do($query) or $self->logge("Alert: $DBI::errstr: $query");
my $dquery = "DELETE FROM uris WHERE uriid=?";
$self->logge("Debug: Non-uniq-Error; trying: $dquery/$hash_orig->{uriid}");
$dbh->do($dquery, undef, $hash_orig->{uriid}) or $self->logge("Debug: $DBI::errstr: $dquery");
$self->logge("Debug: retry now: $dquery/$hash_orig->{uriid}");
$dbh->do($dquery, undef, $hash_orig->{uriid}) or $self->logge("Alert: $DBI::errstr: $dquery");
}
return 1;
}
Expand Down
14 changes: 8 additions & 6 deletions lib/PAUSE/dist.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -80,8 +80,8 @@ sub delete_goner {
return;
}
my $dbh = $self->connect;
$dbh->do("DELETE FROM packages WHERE dist='$dist'");
$dbh->do("DELETE FROM distmtimes WHERE dist='$dist'");
$dbh->do("DELETE FROM packages WHERE dist=?", undef, $dist);
$dbh->do("DELETE FROM distmtimes WHERE dist=?", undef, $dist);
}

# package PAUSE::dist;
Expand Down Expand Up @@ -114,12 +114,12 @@ sub mtime_ok {
unless ($otherts){ # positive $otherts means it was alive last time
# Hahaha: he didn't think of the programmer who wants to
# introduce locking:
# $dbh->do("DELETE FROM distmtimes WHERE dist='$dist'");
# $dbh->do("DELETE FROM distmtimes WHERE dist=?", undef, $dist);

local($dbh->{RaiseError}) = 0;
# this may fail if we have a race condition, but we'll
# decide later if this is the case:
$dbh->do("INSERT INTO distmtimes (dist) VALUES ('$dist')");
$dbh->do("INSERT INTO distmtimes (dist) VALUES (?)", undef, $dist);
}
my $MLROOT = $self->mlroot;
my $mtime = (stat "$MLROOT/$dist")[9];
Expand Down Expand Up @@ -1082,10 +1082,11 @@ sub lock {
my $dbh = $self->connect;
my $rows_affected = $dbh->do(
"UPDATE distmtimes SET indexing_at=?
WHERE dist='$dist'
WHERE dist=?
AND indexing_at IS NULL",
undef,
PAUSE->_now_string,
$dist,
);
return 1 if $rows_affected > 0;
my $sth = $dbh->prepare("SELECT * FROM distmtimes WHERE dist=?");
Expand All @@ -1112,9 +1113,10 @@ sub set_indexed {
my $dist = $self->{DIST};
my $dbh = $self->connect;
my $rows_affected = $dbh->do(
"UPDATE distmtimes SET indexed_at=? WHERE dist='$dist'",
"UPDATE distmtimes SET indexed_at=? WHERE dist=?",
undef,
PAUSE->_now_string,
$dist,
);
$rows_affected > 0;
}
Expand Down
16 changes: 8 additions & 8 deletions lib/PAUSE/package.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -126,8 +126,8 @@ sub perm_check {

my($userid) = $self->{USERID};

my $ins_perms = "INSERT INTO perms (package, userid) VALUES ".
"('$package', '$userid')";
my $ins_perms = "INSERT INTO perms (package, userid) VALUES (?, ?)";
my @ins_params = ($package, $userid);

# package has any authorized maintainers? --> case insensitive
my($auth_ids) = $dbh->selectall_arrayref(qq{
Expand All @@ -150,11 +150,11 @@ sub perm_check {
if ($self->{FIO}{DIO} && $self->{FIO}{DIO}->isa_regular_perl($dist)) {
local($dbh->{RaiseError}) = 0;
local($dbh->{PrintError}) = 0;
my $ret = $dbh->do($ins_perms);
my $ret = $dbh->do($ins_perms, undef, @ins_params);
my $err = "";
$err = $dbh->errstr unless defined $ret;
$ret ||= "";
# print "(primeur)ins_perms[$ins_perms]ret[$ret]err[$err]\n";
# print "(primeur)ins_perms[$ins_perms/@ins_params]ret[$ret]err[$err]\n";

return 1; # P2.1, P3.0
}
Expand All @@ -170,11 +170,11 @@ sub perm_check {

local($dbh->{RaiseError}) = 0;
local($dbh->{PrintError}) = 0;
my $ret = $dbh->do($ins_perms);
my $ret = $dbh->do($ins_perms, undef, @ins_params);
my $err = "";
$err = $dbh->errstr unless defined $ret;
$ret ||= "";
# print "(primeur)ins_perms[$ins_perms]ret[$ret]err[$err]\n";
# print "(primeur)ins_perms[$ins_perms/@ins_params]ret[$ret]err[$err]\n";

return 1; # P2.1, P3.0
}
Expand Down Expand Up @@ -235,11 +235,11 @@ owner[$owner]
# package has no existence in perms yet, so this guy is OK

local($dbh->{RaiseError}) = 0;
my $ret = $dbh->do($ins_perms);
my $ret = $dbh->do($ins_perms, undef, @ins_params);
my $err = "";
$err = $dbh->errstr unless defined $ret;
$ret ||= "";
$self->verbose(1,"Package is new: (uploader)ins_perms[$ins_perms]ret[$ret]err[$err]\n");
$self->verbose(1,"Package is new: (uploader)ins_perms[$ins_perms/@ins_params]ret[$ret]err[$err]\n");

}
$self->verbose(1,sprintf( # just for debugging
Expand Down
62 changes: 34 additions & 28 deletions lib/pause_1999/edit.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -877,6 +877,7 @@ sub edit_cred {
# }
# next if $mgr->{User}{$field} eq $s;

# not ?-ising this as rely on quote() method
push @set, "$field = " . $dbh->quote($s);
$mb = sprintf($mailsprintf1,
$field,
Expand All @@ -901,9 +902,10 @@ sub edit_cred {
}
if (@set) {

my @query_params = ($now, $mgr->{User}{userid}, $u->{userid});
my $sql = "UPDATE $table SET " . ####
join(", ", @set, "changed = '$now', changedby='$mgr->{User}{userid}'") .
" WHERE $column = '$u->{userid}'"; ####
join(", ", @set, "changed = ?, changedby=?") .
" WHERE $column = ?"; ####
my $mailblurb = qq{Record update in the PAUSE users database:
};
Expand All @@ -919,7 +921,7 @@ The Pause
};
# warn "sql[$sql]mailblurb[$mailblurb]";
# die;
if ($dbh->do($sql)) {
if ($dbh->do($sql, undef, @query_params)) {
push @m, qq{The new data are registered in table $table.<hr />};
$nu = $self->active_user_record($mgr,$u->{userid});
if ($nu->{userid} && $nu->{userid} eq $mgr->{User}{userid}) {
Expand Down Expand Up @@ -1806,20 +1808,19 @@ href="mailto:},
$uriid =~ m!^C/CN/CNANDOR/(?:mp_(?:app|debug|doc|lib|source|tool)|VISEICat(?:\.idx)?|VISEData)!
) {
# Overwriting allowed
my $dele_query = "DELETE FROM uris WHERE uriid = '$uriid'";
$dbh->do($dele_query);
$dbh->do("DELETE FROM uris WHERE uriid = ?", undef, $uriid);
}
my $query = qq{INSERT INTO uris
my $query = q{INSERT INTO uris
(uriid, userid,
basename,
uri,
changedby, changed)
VALUES ('$uriid', '$u->{userid}',
'$filename',
'$uri',
'$mgr->{User}{userid}', '$now')};
VALUES (?, ?, ?, ?, ?, ?)};
my @query_params = (
$uriid, $u->{userid}, $filename, $uri, $mgr->{User}{userid}, $now
);
#display query
my $cp = $mgr->escapeHTML($query);
my $cp = $mgr->escapeHTML("$query/(@query_params)");
push @m, qq{<h3>Submitting query</h3>};
if ($mgr->{UseModuleSet} eq "patchedCGI") {
warn "patchedCGI not supported anymore";
Expand Down Expand Up @@ -1857,7 +1858,7 @@ href="mailto:},
push @m, "Resulting SQL: ", $cp;
}
local($dbh->{RaiseError}) = 0;
if ($dbh->do($query)) {
if ($dbh->do($query, undef, @query_params)) {
$$success .= qq{
The request is now entered into the database where the PAUSE daemon
Expand Down Expand Up @@ -2069,9 +2070,10 @@ sub delete_files {
$blurb .= "WARNING: CHECKSUMS not erasable: $userhome/$f\n";
next;
}
my $sql = "INSERT INTO deletes
VALUES ('$userhome/$f', '$time', '$mgr->{User}{userid}')";
$dbh->do($sql) or next;
$dbh->do(
"INSERT INTO deletes VALUES (?, ?, ?)", undef,
"$userhome/$f", $time, "$mgr->{User}{userid}"
) or next;

$blurb .= "\$CPAN/authors/id/$userhome/$f\n";

Expand All @@ -2080,16 +2082,20 @@ sub delete_files {
my $readme = $f;
$readme =~ s/(\.tar.gz|\.zip)$/.readme/;
if ($readme ne $f && -f $readme) {
$sql = qq{INSERT INTO deletes
VALUES ('$userhome/$readme','$time','$mgr->{User}{userid}')};
$dbh->do($sql) or next;
$dbh->do(
q{INSERT INTO deletes VALUES (?,?,?)}, undef,
"$userhome/$readme", $time, $mgr->{User}{userid},
) or next;
$blurb .= "\$CPAN/authors/id/$userhome/$readme\n";
}
}
} elsif ($req->param('SUBMIT_pause99_delete_files_undelete')) {
foreach my $f ($req->param('pause99_delete_files_FILE')) {
my $sql = "DELETE FROM deletes WHERE deleteid = '$userhome/$f'";
$dbh->do($sql) or warn sprintf "FAILED Query: %s: %s", $sql, $DBI::errstr;
my $sql = "DELETE FROM deletes WHERE deleteid = ?";
$dbh->do(
$sql, undef,
"$userhome/$f"
) or warn sprintf "FAILED Query: %s/: %s", $sql, "$userhome/$f", $DBI::errstr;
}
}
if ($blurb) {
Expand Down Expand Up @@ -2147,9 +2153,9 @@ glory is collected on http://history.perl.org/backpan/});
$sth = $dbh->prepare(qq{SELECT deleteid, changed
FROM deletes
WHERE deleteid
LIKE '$userhome/%'}) #}
LIKE ?}) #}
and
$sth->execute
$sth->execute("$userhome/%")
and
$sth->rows
) {
Expand Down Expand Up @@ -2227,9 +2233,9 @@ sub show_files {
$sth = $dbh->prepare(qq{SELECT deleteid, changed
FROM deletes
WHERE deleteid
LIKE '$userhome/%'})
LIKE ?})
and
$sth->execute
$sth->execute("$userhome/%")
and
$sth->rows
) {
Expand Down Expand Up @@ -4604,9 +4610,9 @@ sub _add_mod_hint {
} else {
$sth = $dbh->prepare(qq{SELECT chapterid
FROM mods
WHERE modid LIKE '$root\::%'});
WHERE modid LIKE ?});

$sth->execute;
$sth->execute("$root\::%");
$chapterid = $mgr->fetchrow($sth, "fetchrow_array");
}

Expand Down Expand Up @@ -4771,8 +4777,8 @@ sub apply_mod {
warn "root[$root]";
$sth = $dbh->prepare("SELECT chapterid
FROM mods
WHERE modid = '$root' OR modid LIKE '$root\::%'");
$sth->execute;
WHERE modid = ? OR modid LIKE ?");
$sth->execute($root, "$root\::%");
my(%appr);
if ($sth->rows) {
while (my $chid = $mgr->fetchrow($sth, "fetchrow_array")) {
Expand Down

0 comments on commit b05f4ad

Please sign in to comment.