Mangler en perl ekspert!
Ved ikke lige om der skal en ekspert til, men en erfarende perl programmer, til at hjælpe mig med en script. Problemet er at jeg ved min domæne udbyder "måske" har en begrændsning ved downloading fra mit domæne, det der skal laves er at der, hvis scriptet indehaver en form for begrændsning, skal redigeres så det ikke på nogle måder begrændser download antallet/farten fra domænet. Scriptet er således ud:#!/usr/bin/perl
use DBI;
use CGI;
$q = new CGI;
$database = "pureftpd";
$hostname = "download.freepaq.dk";
$user = "pureftpd";
$password = "lQsIyhn3";
$dsn = "DBI:mysql:database=$database;host=$hostname";
$dbh = DBI->connect($dsn, $user, $password);
$Dir = $q->path_translated();
$Dir =~ /(.+)\//;
$Dir = $1;
$wwwDir = $Dir;
$Dir =~ s/\/www\//\/ftp\//g;
$File = $q->path_info();
$File =~ /.*\/(.+)/;
$Filename = "/$1";
$Username = '';
$Password = '';
while (! $Username) {
$sth = $dbh->prepare("SELECT Users_UID, Username, Password FROM Users WHERE Dir = '$Dir'");
$sth->execute;
if ($sth->rows) {
$row = $sth->fetchrow_hashref();
$Users_UID = $row->{'Users_UID'};
$Username = $row->{'Username'};
$Password = $row->{'Password'};
$sth->finish;
$set = "Accesses = Accesses + 1, LastAccess = NOW()";
if ($Username eq 'new') {
$Username = sprintf("dl%08d", $Users_UID);
$Password = GetPassword();
$set .= sprintf(", Username = '%s', Password = '%s'", $Username, $Password);
}
$sth = $dbh->prepare("UPDATE Users SET " . $set . " WHERE Users_UID = " . $Users_UID);
$sth->execute;
} else {
$sth->finish;
$sth = $dbh->prepare("INSERT INTO Users (Username, Password, Dir) VALUES ('new', '', '$Dir')");
$sth->execute;
}
}
if (! -e "$Dir$File") {
system("mkdir -p $Dir");
system("ln -s $wwwDir$Filename $Dir$Filename");
}
$sth->finish;
$dbh->disconnect;
$q->redirect("ftp://$Username:$Password\@download.freepaq.dk$Filename");
sub GetPassword {
my ($length) = @_;
$length = 8 if (!$length);
my $pass = '';
srand(time() ^ ($$ + ($$ >> 15)));
while ($length--) {
do {
$_ = chr(rand(abs(ord('0') - ord('z')) + 1) + ord('0'));
} while (/[\W_]/);
if (int(rand(100)) % 2) {
$pass .= $_;
} else {
$pass = $_ . $pass;
};
};
return $pass;
}
