 |
 |
 |
 |
 |
 |
 |
 |
 |
 |
|
|
|
|
|
|
|
|
|
|
  |
Интересные решения Perl. Вопросы и ответыИзменение прав доступа к файлам, используя модуль Net::FTPДопустим, имеется сервер, работющий на Unix/Linux-подобной операционной системе. Хостинг-провайдер может не предоставлять shell-доступ. Как правило, web-сервер, работает не от имени root-пользователя. Таким образом, изменить права доступа к файлам можно только через FTP-протокол. Делать это руками для каждой папки и всех в нее вложенных папок и файлов - очень утомительная процедура. Используя модуль Net::FTP, можно значительно уменьшить прилагаемые усилия.
#!/usr/bin/perl
# 13.08.2006 20:36:34, Alex_K
use strict;
my $ftpServer = '192.168.245.2';
my $ftpLogin = 'alex';
my $ftpPass = '1';
my $ftpDir = '/home/alex/WWW'; # must end without slash
my $SET_PERMS = '0711'; # should start with zero!
print "Set permissions $SET_PERMS (";
my $SET_PERMS_HUMAN = convertDigitsPermsToHuman($SET_PERMS);
print $SET_PERMS_HUMAN . ") for directory $ftpDir\n";
use Net::FTP;
my $ftp = Net::FTP->new($ftpServer, Timeout => 20, Debug => 1, Passive => 1) or die "Can't connect to ftp server.\n";
$ftp->login($ftpLogin, $ftpPass) || die "Can't login to ftp server.\n";
if ($ftp->supported('SITE')) {
# FTP-server supports SITE command
print "FTP-server supports SITE command\n";
ftpDir($ftpDir, 1);
} else {
print "FTP-server doesn't supports SITE command\nWe should stop\n";
}
$ftp->quit();
print "\n";
sub ftpDir($$) {
# first - directory name,
# second - should we change the permissions for it?
if ($_[1]) {
$ftp->site('chmod ' . $SET_PERMS, $_[0]);
}
my @l = $ftp->dir($_[0]);
foreach (@l) {
my $r = dItem($_);
if ($r->{'TYPE'} eq 'DIR') {
ftpDir($_[0] . '/' . $r->{'NAME'}, $r->{'PERMS'} ne $SET_PERMS_HUMAN ? 1 : 0);
} else {
if ($r->{'PERMS'} ne $SET_PERMS_HUMAN) {
# if permissions for a file are different with those that it has -> we should change them
$ftp->site('chmod ' . $SET_PERMS, $_[0] . '/' . $r->{'NAME'});
}
}
}
undef(@l);
}
sub dItem($) {
# gets line from LIST
# returns hash with values for that line
my %r = ();
my ($isDir, $perms, undef, $user, $group, $size, $date, $name) = $_[0] =~ /
^([\-d])(\S+)\s+#permissions
(\S+)\s+#dont know
(\S+)\s+#user
(\S+)\s+#group
(\S+)\s#size
(\w+\s\d+\s\d+:\d+)\s#date
([^\r\n]+)#name
$/x;
$r{'TYPE'} = $isDir eq 'd' ? 'DIR' : 'FILE';
$r{'PERMS'} = $perms;
$r{'USER'} = $user;
$r{'GROUP'} = $group;
$r{'SIZE'} = $size;
$r{'DATE'} = $date;
$r{'NAME'} = $name;
return \%r;
}
sub convertDigitsPermsToHuman($) {
# converts, for example, 0755 to rwxr-xr-x
my $tmp = substr($_[0], 1, 1);
my $r = convertDigitsPermsToHumanOne($tmp);
$tmp = substr($_[0], 2, 1);
$r .= convertDigitsPermsToHumanOne($tmp);
$tmp = substr($_[0], 3, 1);
$r .= convertDigitsPermsToHumanOne($tmp);
return $r;
}
sub convertDigitsPermsToHumanOne($) {
my $r = '';
if ($_[0] eq '0') {
$r .= '---';
} elsif ($_[0] eq '1') {
$r .= '--x';
} elsif ($_[0] eq '2') {
$r .= '-w-';
} elsif ($_[0] eq '3') {
$r .= '-wx';
} elsif ($_[0] eq '4') {
$r .= 'r--';
} elsif ($_[0] eq '5') {
$r .= 'r-x';
} elsif ($_[0] eq '6') {
$r .= 'rw-';
} elsif ($_[0] eq '7') {
$r .= 'rwx';
}
return $r;
}
sub convertHumanPermsToDigits($) {
# converts, for example, rwxr-xr-x to 0755
my $owner = 0;
my $group = 0;
my $world = 0;
my $tmp = substr($_[0], 0, 1);
if ($tmp eq 'r') {
$owner += 4;
}
$tmp = substr($_[0], 1, 1);
if ($tmp eq 'w') {
$owner += 2;
}
$tmp = substr($_[0], 2, 1);
if ($tmp eq 'x') {
$owner += 1;
}
$tmp = substr($_[0], 3, 1);
if ($tmp eq 'r') {
$group += 4;
}
$tmp = substr($_[0], 4, 1);
if ($tmp eq 'w') {
$group += 2;
}
$tmp = substr($_[0], 5, 1);
if ($tmp eq 'x') {
$group += 1;
}
$tmp = substr($_[0], 6, 1);
if ($tmp eq 'r') {
$world += 4;
}
$tmp = substr($_[0], 7, 1);
if ($tmp eq 'w') {
$world += 2;
}
$tmp = substr($_[0], 8, 1);
if ($tmp eq 'x') {
$world += 1;
}
return "0$owner$group$world";
}
=head
sample LIST
-rw-r--r-- 1 alex wheel 77 Aug 13 09:09 1.html
-rw-r--r-- 1 alex wheel 324 Aug 13 09:09 1.php
-rw-r--r-- 1 alex wheel 596 Aug 13 09:09 2.php
drwxr-xr-x 4 alex wheel 512 Aug 13 09:06 alex
drwxr-xr-x 5 alex wheel 512 Aug 13 09:06 articles
drwxr-xr-x 4 alex wheel 512 Aug 13 09:07 cgi-bin
drwxr-xr-x 7 alex wheel 512 Aug 13 09:07 common_files
=cut
Этот Perl-код для всех папок и файлов, находящихся внутри $ftpDir, рекурсивно использует команду SITE FTP-сервера для выполнения смены прав доступа. Опубликовано: 02 сентября 2006 года. Комментарии посетителей сайта
|
| ||||||
| © Алексей Кощеев, г.Киров, 2001-2023 |
