Приглашаем посетить
8.9. Обработка текстовых полей переменной длины
Проблема
Требуется извлечь из входных данных поля переменной длины.
Решение
Воспользуйтесь функцией split с шаблоном, совпадающим с разделителями полей:
# Имеется $ЗАПИСЬ с полями, разделенными шаблоном ШАБЛОН.
# Из записи извлекаются @ПОЛЯ.
@П0ЛЯ = split(/ШАБЛОН/, $ЗАПИСЬ);
Комментарий
Функция split вызывается с тремя аргументами: шаблон, выражение и лимит (максимальное количество извлекаемых полей). Если количество полей во входных данных превышает лимит, лишние поля возвращаются неразделенными в последнем элементе списка. Если лимит не указан, возвращаются все поля (кроме завершающих пустых полей). Выражение содержит разделяемую строковую величину. Если выражение не указано, разделяется переменная $_. Шаблон совпадает с разделителем полей. Если шаблон не указан, в качестве разделителей используются смежные последовательности пропусков, а начальные пустые поля отбрасываются.
Если разделитель входных полей не является фиксированной строкой, можно вызвать split так, чтобы функция возвращала разделители полей вместе с данными, - для этого в шаблон включаются круглые скобки. Например:
split(/([+-])/, "3+5-2");
возвращает список:
(3, '+', 5, '-', 2)
Поля, разделенные двоеточиями (в стиле файла /etc/passwd), извлекаются следующим образом:
@fields = split(/:/, $record):
Классическое применение функции split - извлечение данных, разделенных пропусками:
@fields = split(/\s+/, $record);
Если $ЗАПИСЬ начинается с пропуска, в последнем варианте первому элементу списка будет присвоена пустая строка, поскольку split сочтет, что запись имеет начальное пустое поле. Если это не подходит, используйте особую форму split:
#fields = split(" ", $ЗАПИСЬ);
В этом случае split ведет себя так же, как и с шаблоном /\s+/, но игнорирует начальный пропуск.
Если разделитель может присутствовать внутри самих полей, возникает проблема. Стандартное решение - снабжать экземпляры разделителя в полях префиксом \. См. рецепт 1.13.
Смотри также: Описание функции split в perlfunc(1).
Проблема
Требуется удалить из файла последнюю строку.
Решение
Читайте файл по одной строке и запоминайте байтовое смещение последней прочитанной строки. Когда файл будет исчерпан, обрежьте файл по последнему сохраненному смещению:
open (FH, "+< $file") or die "can't update $file: $!";
while ( ) {
$addr = tell(FH) unless eof(FH);
} truncate(FH, $addr) or die "can't truncate $file: $!";
Комментарий
Такое решение намного эффективнее загрузки всего файла, поскольку в любом момент времени в памяти хранится всего одна строка. Хотя вам все равно приходится читать весь файл, программу можно использовать и для больших файлов, размер которых превышает объем доступной памяти.
Смотри также: Описание функций open и binmode в perlfunc(1); man-страницы ореn(2) и fореn(2) вашей системы.
Проблема
Операционная система отличает текстовые файлы от двоичных. Как это сделать в программе?
Решение
Вызовите функцию binmode для файлового манипулятора:
binmode(МАНИПУЛЯТОР);
Комментарий
Не существует единого мнения по поводу того, что является строкой текстового файла; текстовые символы одного компьютера могут превратиться в двоичную белиберду на другом. Но даже если все станут пользоваться кодировкой ASCII вместо EBCDIC, Rad50 или Unicode, могут возникнуть затруднения.
Как говорилось во введении, конкретного символа перевода строки не существует. Это чисто абстрактное понятие, которое поддерживается операционной системой, стандартными библиотеками, драйверами устройств и Perl.
В Unix или Р1ап9 "\п" представляет физическую последовательность "\cJ" (служебная последовательность Perl, соответствующая Ctrl+J). Однако на терминале, не работающем в "чистом" (raw) режиме, нажатие на клавишу Enter генерирует код "\сМ" (возврат курсора), транслируемый в "\cJ", а выходной код "\cJ" транслируется в "\cM\cJ". Подобные странности характерны не для обычных файлов, а лишь для терминальных устройств, и обрабатываются строго на уровне драйвера устройства.
На Мае код "\п" обычно представляется "\сМ"; чтобы жизнь была интереснее (а также из-за стандартов, требующих различий между "\п" и "\г"), "\г" соответствует "\cJ". Такая интерпретация в точности противоположна стандартам UNIX, Plan9, VMS, CP/M... словом, почти всем. Следовательно, программисты Мае, которые пишут файлы для других систем или общаются с ними по сети, должны проявлять осторожность. Если отправить "\п", вы получите "\сМ", a "\cJ" исчезнет. Многие сетевые службы предпочитают отправлять и принимать в качестве разделителя строк последовательность "\cM\cJ", однако большинство позволяет ограничиться простым "\cJ".
В VMS, DOS и их производных "\п" также представляет "\cJ", по аналогии с Unix и Plan9. С терминальной точки зрения UNIX и DOS ведут себя одинаково:
при нажатии пользователем клавиши Enter генерируется "\сМ", однако в программу поступает уже "\п", то есть "\cJ". Код "\п", переданный терминалу, превращается в "\cM\cJ".
Эти странные преобразования выполняются и с файлами Windows. В текстовых файлах DOS каждая строка завершается двумя символами, "\cM\cJ". Последний блок файла содержит код "\cZ", определяющий окончание текста. В таких системах при записи строки "bad news\n" файл будет содержать "bad news\cM\cJ", как при выводе на терминал.
Но при чтении строк в таких системах происходят еще более странные вещи. Файл содержит "bad news\cM\cJ" - строку, состоящую из 10 байт. При чтении ваша программа не получит ничего, кроме "bad news\n", где "\n" - виртуальный символ перевода строки, то есть "\cJ". Следовательно, от него можно избавиться одним вызовом chop или chomp. Однако при этом приходится обманывать бедную программу и внушать ей, что из файла было прочитано всего 9 байт. Если прочитать 10 таких строк, она будет полагать, что из файла было прочитано 90 байт, хотя в действительности смещение будет равно 100. Из-за этого для определения текущей позиции всегда следует использовать функцию tell. Простой подсчет прочитанных байтов не подходит.
Такое наследие старой файловой системы СР/М, в которой хранились лишь сведения о количестве блоков, но не о размере файлов, бесит программистов уже несколько десятилетий, и конца-края этому не видно. Ведь DOS была совместима с файловым форматом СР/М, Windows - с форматом DOS, a NT - с форматом Windows. Грехи отцов преследуют потомков в четвертом поколении.
Впрочем, проблему одиночного "\п" можно обойти - достаточно сообщить Perl (и операционной системе), что вы работаете с двоичными данными. Функция binmode означает, что прочитанные или записанные через конкретный манипулятор данные не должны преобразовываться по правилам, установленным в системе для текстовых файлов.
$gifname = "picture.gif";
open(GIF, $gifname) or die "can't open $gifname: $!";
binmode(GIF); # Теперь DOS не преобразует двоичные
# входные данные GIF binmode(STDOUT);
# Теперь DOS не преобразует двоичные
# выходные данные STDOUT
while (read(GIF, $buff, 8 * 2**10)) { print STDOUT $buff;
}
Вызов binmode в системах, где отличия между текстовыми и двоичными файлами несущественны (в том числе UNIX, Mac и Plan9), не принесет никакого вреда. Однако несвоевременный вызов функции в других системах (включая MVS, VMS и всех разновидностей DOS) может исказить содержимое файлов.
Если функция binmode не используется, в данных, прочитанных с помощью о, строковый терминатор системы заменяется на "\n", даже если $/ было присвоено другое значение. Аналогично, любой "\n", выводимый через манипулятор функцией print, превращается в строковый терминатор данной системы. Дополнительные сведения приведены во введении.
Если вы хотите, чтобы прочитанные данные совпадали с содержимым файла байт в байт, и при этом работаете в одной из перечисленных странных систем, -вызовите binmode. Конечно, если вы захотите использовать их с о, вам придется присвоить $/ настоящий разделитель записей.
Смотри также: Описание функций open и binmode в per!func(1); страницы руководства орen( 2) и fopen(3) вашей системы.
Проблема
Нужно прочитать двоичную запись из середины большого файла, но вам не хочется добираться до нее, последовательно читая все предыдущие записи.
Решение
Определите размер записи и умножьте его на номер записи, чтобы получить смещение в байтах. Затем вызовите seek для полученного смещения и прочитайте запись:
$АДРЕС = $РАЗМЕР * $НОМБР;
seek(FH, $АДРЕС, 0) or die "seek:$!";
read(FH, $БУФЕР, $РАЗМЕР);
Комментарий
В решении предполагается, что $НОМЕР первой записи равен нулю. Если нумерация начинается с единицы, измените первую строку фрагмента:
$АДРЕС = $РАЗМЕР * ($НОМЕР-1);
Для текстовых файлов это решение не работает - только строки не имеют одинаковую длину. Но такие ситуации встречаются очень редко.
Смотри также: Описание функции seek в perlfunc(1); рецепт 8.13.
Проблема
Требуется прочитать старую запись из двоичного файла, изменить ее содержимое и записать обратно.
Решение
Прочитайте (read) старую запись, упакуйте (pack) обновленное содержимое и запишите обратно.
use Fcnti; #Для SEEK_SET и SEEK_CUR
$ADDRESS = srecsize * $recno;
seek(FH, SADDRESS. SEEK_SET) or die "Seeking: $!";
read(FH, $BUFFER, $RECSIZE) == $recsize
or die "Reading: $!";
OFIELDS = unpack($format, $buffer);
# Обновить содержимое, затем
$BUFFER = pack($format, fields);
seek(FH, -$RECSIZE, SEEK_CUR) or die "Seeking: $!":
print FH $BUFFER;
close FH or die "Closing: $!";
Комментарий
Для вывода записей в Perl не потребуется ничего, кроме функции print. Помните, что антиподом read является print, а не write, хотя, как ни странно, антиподом sysread все же является syswrite.
В примере 8.4 приведен исходный текст программы weekearly, которой передается один аргумент - имя пользователя. Программа смещает дату регистрации этого пользователя на неделю в прошлое. Конечно, на практике с системными срайлами экспериментировать не следует - впрочем, из этого все равно ничего не выйдет! Программа должна иметь право записи для 4)ДЙла, поскольку тот открывается в режиме обновления. После выборки и изменения записи программа упаковывает данные, возвращается на одну запись назад и записывает буфер.
Пример 8.4. weekearly
#!/usr/bin/perl
# weekearly - смещение даты регистрации на неделю назад
use User::pwent;
use IO::Seekable;
$typedef = 'l a12 a16'; # Формат linux : в sunos - "l a8 a16"
$sizeof = length(pack($typedef, ()));
$user = shift(@argv) || $env{user} [| $env{logname};
$address = getpwnam($user)->uid * $sizeof;
open (LASTLOG, "+or die "can't update /usr/adm/lastlog: $!";
seek(LASTLOG, $address, SEEK_SET)
or die "seek failed: $!";
read(LASTLOG, $buffer, $sizeof) == $sizeof
or die "read failed: $!";
($time, $line, $host) = unpack($typedef, $buffer);
$time -= 24 * 7 * 60 * 60; # На неделю назад
$buffer = pack($typedef, $time, $line, $time);
seek(LASTLOG, -$sizeof, SEEK_CUR) # Вернуться на одну запись
or die "seek failed: $!";
print LASTLOG $record;
close(LASTLOG)
or die "close failed: $!";
Смотри также: Описание функций open, seek, read, pack и unpack в perlfunc(i); рецепты 8.12; 8.14.
Проблема
Требуется прочитать из файла строку, завершенную нуль-символом, начиная с определенного адреса.
Решение
Присвойте $/ нуль-символ ASCII и прочитайте строку с помощью :
$old_rs = $/; # Сохранить старое значение $/
$/ = "\0"; # Нуль-символ
seek(FH, $addr, SEEK_SET) or die "Seek error: $!\n":
$string = ; # Прочитать строку
chomp Ss.tring; # Удалить нуль-символ
$/ = $old_rs: # Восстановить старое значение $/
При желании сохранение и восстановление $/ можно реализовать с помощью local:
{
local $/ ^ "\0";
# ...
} # $/ восстанавливается автоматически
Комментарий
Программа bgets из примера 8.5 получает в качестве аргументов имя файла и одно или несколько байтовых смещений. Допускается десятичная, восьмеричная или шестнадцатеричная запись смещений. Для каждого смещения программа читает и выводит строку, которая начинается в данной позиции и завершается нуль-символом или концом файла:
Пример 8.5. bgets
#!/usr/bin/perl
# bgets - вывод строк по смещениям в двоичном файле
use IO::Seekable;
($file, @addrs) = @argv or die "usage: $0 addr ...";
open(FH, $file) or die "cannot open $file: $!";
$/ = "\000";
foreach $addr (@addrs) {
$addr = oct $addr if $addr =~ /"0/;
seek(FH, $addr, SEEK_SET)
or die "can't seek to $addr in $file: $!";
printf qq{%ftx %fto %d "%s"\n}, $addr, $addr, $addr, scalar <>;
}
Приведем простейшую реализацию программы UNIX strings:
Пример 8.6. strings
#!/usr/bin/perl
# strings - извлечение строк из двоичного файла
$/ = "\0";
while (<>) {
while (/([\040-\176\s]{4,})/g) { print $1, "\n";
}
}
Смотри также: Описание функций seek, getc и ord в perlfunc(1); описание qq// в разделе "Quote and Quote-like Operators" man-страницы perlop(i).
Проблема
Требуется прочитать файл с записями фиксированной длины.
Решение
Воспользуйтесь функциями pack и unpack:
# $RECORDSIZE - длина записи в байтах.
# $TEMPLATE - шаблон распаковки для записи
# FILE - файл, из которого читаются данные
# @FIELDS - массив для хранения полей
until ( eof(FILE) ) {
read(FILE, $record, $RECORDSIZE) == $recordsize or die "short read\n";
@FIELDS = unpack($template, $record);
}
Комментарий
Поскольку мы работаем не с текстовым, а с двоичным файлом, для чтения записей нельзя воспользоваться оператором <. . .> или методом getline модулей 10: :. Вместо этого приходится считывать конкретное количество байт в буфер
функцией read. После этого буфер содержит данные одной записи, которые декодируются функцией unpack с правильным форматом.
При работе с двоичными данными трудности часто начинаются как раз с правильного выбора формата. Если данные были записаны программой на С, приходится просматривать заголовочные файлы С или страницы руководства с описанием структур, для чего необходимо знание языка С. Заодно вы должны близко подружиться с компилятором С, поскольку без этого вам будет трудно разобраться с выравниванием полей (например, х2 в формате из рецепта 8.18). Если вам посчастливилось работать в Berkeley UNIX или в системе с поддержкой дсс, вы .'.можете воспользоваться утилитой c2ph, распространяемой с Perl, и заставить компилятор С помочь вам в этом.
Программа tailwtmp в конце этой главы использует формат, описанный в utmp(5) системы Linux, и работает с файлами /var/log/wtmp и /var/run/utmp. Но стоит нам привыкнуть к работе с двоичными данными, как возникает другая напасть - особенности конкретных компьютеров. Вероятно, программа не будет работать в вашей системе без изменений, но выглядит она поучительно. Приведем соответствующую структуру из заголовочного файла С для Linux:
#define UT_LINESIZE
12 #define UT.NAMESIZE
8 #define UT_HOSTSIZE
16
struct utmp { /* Коды для шаблона распаковки */
short ut_type; /* s - short, должно быть дополнено */
pid_t ut_pid; /* i для integer */
char ut_line[UT_LINESIZE]; /* A12 - 12-символьная строка */
char ut_id[2]; /* A2, но для выравнивания
необходимо х2 */ time_t ut_time; /*
1 - long */ char ut_user[UT_NAMESIZE]; /*
AS - 8-символьная строка */ char ut_host[UT_HOSTSIZE]; /*
A16 - 16-символьная строка */ long ut_addr; /*
1 - long */
};
Вычисленная двоичная структура (в нашем примере - "s х2 i A12 A2 х2 1 A16 I") передается pack с пустым списком полей для определения размера записи. Не забудьте проверить код возврата read при чтении записи, чтобы убедиться в том, что вы получили запрошенное количество байт.
Если записи представляют собой текстовые строки, используйте шаблон рас-. паковки "а" или "А".
. Записи фиксированной длины хороши тем, что п-я запись начинается в фай-|е со смещения SIZE*(n-1), где SIZE - размер одной записи. Пример приведен в зограмме с построением индекса из рецепта 8.8.
Смотри также: Описание функций unpack, pack и read в perlfunc{1) рецепт 1.1.
Проблема
Вы хотите, чтобы пользователи вашей программы могли изменить ее поведение с помощью конфигурационного файла.
Решение
Организуйте обработку файла в тривиальном формате ПЕРЕМЕННАЯ=ЗНАЧЕНИЕ, создавая для каждого параметра элемент хэша "ключ/значение":
while () {
chomp; и Убрать перевод строки
s/й.*//; # Убрать комментарии
s/~\s+//; # Убрать начальные пропуски
s/\s+$//: # Убрать конечные пропуски
next unless length; # Что-нибудь осталось?
my ($var, $value) = split(/\s*=\s*/, $_, 2);
$User_Preferences{$var} = $value;
}
Существует другой более изящный вариант - интерпретировать конфигурационный файл как полноценный код Perl:
do "$ENV{HOME}/.progrc";
Комментарий
В первом решении конфигурационный файл интерпретируется в тривиальном формате следующего вида (допускаются комментарии и пустые строки):
# Сеть класса С NETMASK = 255.255.255.0 mtu = 296
device = cua1 rate = 115200 mode = adaptive
После этого можно легко получить значение нужных параметров - например, $User_Preferences{"RATE"} дает значение 115200. Если вы хотите, чтобы конфигурационный файл непосредственно устанавливал значения переменных в программе вместо заполнения хэша, включите в программу следующий фрагмент:
no strict 'rets';
$$var = $value;
и переменная $RATE будет содержать значение 115200.
Во втором решении do организует непосредственное выполнение кода Perl, Если вместо блока используется выражение, do интерпретирует его как имя фай" ла. Это практически идентично применению require, но без риска фатальных
исключений. В формате второго решения конфигурационный файл принимает следующий вид:
# Сеть класса С $NETMASK = -255.255.255.О':
$MTU = 0х128;
$DEVICE = ocua1';
$RATE = 115_200;
$MODE = 'adaptive';
Если вам непонятно, зачем включать в файл лишние знаки препинания, задумайтесь - в вашем распоряжении оказывается весь синтаксис Perl. Теперь простые присваивания можно дополнить логикой и проверкой условий:
if ($DEVICE =~ /1$/) {
$RATE = 28_800;
} else {
$RATE = 115_200;
}
Во многих программах предусмотрены системные и личные конфигурационные файлы. Если вы хотите, чтобы предпочтения пользователя отменяли действия системных параметров, загрузите личный файл после системного:
SAPPDFLT = "/usr/local/share/myprog";
do "$APPDFLT/sysconfig.pl";
do "$ENV{HOME}/.myprogrc";
Если при существующем личном файле системный файл должен игнорироваться, проверьте возвращаемое значение do:
do "$APPDFLT/sysconfig.pl"
or do "$ENV{HOME}/.myprogrc";
Возможно, вас интересует, в каком контексте должны выполняться эти файлы. Они будут принадлежать пакету, в котором была откомпилирована команда do. Обычно пользователи устанавливают значения конкретных переменных, которые представляют собой неуточненные глобальные величины и потому принадлежат текущему пакету. Если вы предпочитаете, чтобы неуточненные переменные относились к конкретному пакету, воспользуйтесь записью вида:
{ package Settings; do "$ENV{HOME}/.myprogcc" }
Файл, прочитанный с помощью do (а также require и use), представляет собой отдельную, самостоятельную область действия. Это означает как то, что конфигурационный файл не может обратиться к лексическим (mу) переменным вызывающей стороны, так и то, что вызывающая сторона не сможет найти такие переменные, заданные в файле. Кроме того, пользовательский код не подчиняется директивам типа use strict или use integer, способным воздействовать на выбывающую сторону.
Если столь четкое разграничение видимости переменных нежелательно, вы можете заставить код конфигурационного файла выполняться в вашей лексической области действия. Имея под рукой программу cat или ее эквивалент, можно написать доморощенный аналог do:
eval 'cat $ENV{HOME}/.myprogrc';
Мы еще не видели, чтобы кто-нибудь (кроме Ларри) использовал такой подход в рабочем коде.
Во-первых, do проще вводится. Кроме того, do учитывает @INC, который обычно просматривается при отсутствии полностью указанного пути, но в отличие oт require в do не выполняется неявная проверка ошибок. Следовательно, вам не придется заворачивать do в eval для перехвата исключений, от которых ваша программа может скончаться, поскольку do уже работает как eval.
При желании можно организовать собственную проверку ошибок:
$file = "someprog.pi";
unless ($return = do $file) {
warn "couldn't parse $file: $@" if $@;
warn "couldn't do $file: $!" unless defined $return;
warn "couldn't run $file" unless $return;
}
Программисту намного проще отследить это в исходном тексте, чем изобретать новый, сложный синтаксис. Проще будет и пользователю, которому не придется изучать правила синтаксиса очередного конфигурационного файла. Приятно и то, что пользователь получает доступ к мощному алгоритмическому языку программирования.
Однако не следует забывать о безопасности. Как убедиться в том, что файл не модифицировался никем, кроме пользователя? Традиционный подход - не делать ничего, полагаясь исключительно на права доступа каталогов и файлов. В девяти случаях из десяти такое решение оказывается правильным, поскольку большинство проектов попросту не оправдывает подобной паранойи. А если все же оправдывает, загляните в следующий рецепт.
Смотри также: Описание функций eval и require в perlfunc(1); рецепты 8.17; 10.12.
Проблема
Требуется прочитать файл (например, содержащий данные о конфигурации). BL хотите использовать файл лишь в том случае, если правом записи в него (а возможно, даже правом чтения) не обладает никто, кроме его владельца.
Решение
Получите данные о владельце и правах доступа с помощью функции stat. Можи воспользоваться встроенной версией, которая возвращает список:
( $dev, $ino. $mode, $nlink, $uid, $gid, $rdev, $size, $atime, $mtime, $ctime, $blksize,
$blocks )
= stat($filename) or die "no $filenanie: $!";
$mode &= 07777; # Отбросить информацию о типе файла Или воспользуйтесь
# интерфейсом с именованными полями:
$info = stat($filename) or die "no $filename: $!":
if ($info->uid == 0) {
print "Superuser owns $filename\n";
} if ($info->atime > $info->mtime) {
print "$filename has been read since it was written.\n";
}
Комментарий
Обычно мы доверяем пользователям и позволяем им устанавливать права доступа по своему усмотрению. Если они захотят, чтобы другие могли читать или даже записывать данные в их личные файлы - это их дело. Однако многие приложения (редакторы, почтовые программы, интерпретаторы) часто отказываются выполнять код конфигурационных файлов, если запись в них осуществлялась кем-то, кроме владельца. Это помогает избежать нападений "троянских" программ. Программы, следящие за безопасностью - например, ftp или riogin, - могут даже отвергнуть конфигурационные файлы, прочитанные кем-то, кроме владельца.
Если файл может быть записан кем-то, кроме владельца, или принадлежит кому-то, отличному от текущего или привилегированного пользователя, он не признается достоверным. Информация о владельце и правах доступа может быть получена с помощью функции star. Следующая функция возвращает true для достоверных файлов и false для всех остальных. Если вызов stat завершается неудачей, возвращается undef.
use File::stat;
sub is_safe {
my $path = shift;
my $info = stat($path);
return unless $info;
# Проверить владельца (привилегированный или текущий пользователь)
# Настоящий идентификатор пользователя хранится в переменной $<.
if (($info->uid != 0) && ($info->uid != $<)) { return 0;
}
# Проверить, может ли группа или остальные пользователи
# записывать в файл.
# Для проверки чтения/записи используйте константу 066
# ($info->mode & 022) { # Если другие имеют право записи
return 0 unless -d _; # He-каталоги недостоверны
# но каталоги с битом запрета (01000) - достоверны
return 0 unless $info->mode & 01000;
}
return 1;
}
Каталог считается достоверным даже в том случае, если другие имеют право записи в него - при условии, что для пего установлен бит 01000 (разрешающим удаление только владельцу каталога).
Осторожный программист также проследит, чтобы запись была запрещена и для всех каталогов верхнего уровня. Это связано с известной "проблемой chown", при которой любой пользователь может передать принадлежащий ему файл и сделать его владельцем кого-то другого. Приведенная ниже функция ls_very_safe обращается к функции POSIX: :sysconf, чтобы выяснить, существует ли "проблема chown" в системе. Если проблема существует, далее функцией проверяются is_safe все каталоги верхнего уровня вплоть до корневого. Если в вашей системе установлена ограниченная версия chown, функция is_very_safe ограничивается простым вызовом is_safe.
use Cwd;
use POSIX qw(sysconf _PC_CHOWN_RESTRICTED);
sub is_verysafe { my $path = shift;
return is_safe($path) if sysconf(_PC_CHOWN_RESTRICTED);
$path = getcwd() . o/o . $path if $path !~ m{^/};
do {
return unless is_safe($path);
$path =~ s#(["/]+|/)$##; # Имя каталога
$path =~ s#/$## if length($path) > 1; # Последний символ /
} while length $path:
return 1;
}
В программе эта функция используется примерно так:
$file = ".$env{home}/.my.progrc";
readconfig($file) if is_safe($file);
При этом возникает потенциальная опасность перехвата, поскольку предполагается, что файл открывается гипотетической функцией readconfig. Между получением сведений о файле (is_safe) и его открытием функцией readconfic теоретически может случиться что-нибудь плохое. Чтобы избежать перехвата, передавайте is_safe уже открытый файловый манипулятор:
$file = "$env{home}/.myprogrc";
if (open(FILE, oo< $file")) {
readconfig(*FILE) if is_safe(*FILE);
}
Впрочем, вам также придется позаботиться о том, чтобы функция readconfig принимала файловый манипулятор вместо имени.
В начале и конце рабочего сеанса пользователя в системе UNIX в файл wtmp добавляется новая запись. Вам не удастся получить ее с помощью обычной программы tail, поскольку файл хранится в двоичном формате. Программа tailwtmp из примера 8.7 умеет работать с двоичными файлами и выводит новые записи по мере их появления. Формат pack придется изменить для конкретной системы.
Пример 8.7. tailwtmp
#!/usr/bin/perl
# tailwtmp - отслеживание начала/конца сеанса
# Использует структуру linux utmp, см. utmp(5)
$typedef = 's x2 i a12 a4 1 a8 a16 l;
$sizeof = length pack($typedef, () ):
use IO::File;
open(WTMP, '/var/log/wtmp') or die "can't open /var/log/wtmp: $!";
seek(WTMP, 0, SEEK_END);
for (;;) {'
while (read(WTMP, $buffer, $sizeof) == $sizeof) { ($type, $pid, $line, $id, $time,
$user, $host, $addr) = unpack($typedef, $buffer);
next unless $user && ord($user) && $time;
printf "%1d %-8s %-12s %2s %-24s %-16s %5d %08x\n",
$type,$user,$line,$id,scalar(localtime($time)), $host,$pid,$addr;
}
for ($size = -s wtmp; $size == -s wtmp; sleep 1) {}
WTMP->clearerr();
}
Во многих системах существует классическая программа tee для направления выходных данных в несколько приемников. Например, следующая команда передает выходные данные someprog в/tmp/output и через конвейер - в почтовую систему:
% someprog | tee /Imp/output | Mail -s 'check this' userohost.org
Программа tctee пригодится не только тем пользователям, которые работают вне UNIX и не имеют tee. Она обладает некоторыми возможностями, отсутствующими в стандартной версии tee.
При запуске программа может получать четыре флага:
-i -игнорировать прерывания,
-а - дописывать данные в конец выходных файлов,
-u - выполнять небуферизованный вывод,
-n - отменить копирование выходных данных в стандартный вывод.
Поскольку в программе используется "волшебная" функция open, вместо файлов можно передавать каналы:
% someprog ] tctee f1 "|cat -n" f2 ""f3"
В примере 8.8 приведена программа-ветеран, написанная на Perl почти 10 лет назад и работающая до сих пор. Если бы нам пришлось писать ее заново, вероятно, мы бы использовали strict, предупреждения и модули с десятками тысяч строк. Но как известно, "лучшее - враг хорошего".
Пример 8.8. tctee
#!/usr/bin/perl
# tctee - клон tee
# Программа совместима с perl версии 3 и выше.
while ($ARGV[0] =~ /"-(.+)/ && (shirt, ($_ = $1), 1)) { next if /"$/;
s/i// && (++$ignore_ints, redo);
s/a// && (++$append, redo);
s/u/7- && (++$unbuffer, redo):
s/n// && (++$nostdout, redo);
die "usage tee [-aiun] [filenames] ...\n";
}
if ($ignore_ints) {
for $sig CINT', 'TERM', 'HUP', 'QUIT') { $SIG{$sig} = 'ignore'; }
}
$SIG{'PIPE'} = 'plumber';
$rnode = $append ? '>>' : '>';
$fh = 'fhooo';
unless ($nostdout) {
%fh = ('stdout', 'standard output'); # Направить в stoout
}
$| = 1 if $unbuffer;
for (@ARGV) {
if (!open($fh, (/"[">]]/ && $mode) . $_)) {
warn "$0: cannot open $_: $!\n"; # Как в sun; я предпочитаю die
$status++;
next;
}
select((select($fh), $| =1)[0]) if $unbuffer;
$fh{$fh++} = $_;
}
while () {
for $fh (keys %fh) {
print $fh $_;
}
}
for $fh (keys %fh) {
next if close($fh) || !defined $fh{$fh};
warn "$0: couldnt close $fh{$fh}: $!\n";
$status++;
}
exit $status;
sub PLUMBER {
warn "$0: pipe to \"$fh{$fh}\" broke!\n' $status++;
delete $fh{$fh};
}
Во время регистрации в системе UNIX на экран выводятся сведения о времени последней регистрации. Эта информация хранится в двоичном файле с именем lastlog. Каждый пользователь имеет собственную запись в этом файле; данные пользователя с UID 8 хранятся в записи 8, UID 239 - в записи 239 и т. д. Чтобы узнать, когда пользователь с заданным UID регистрировался в последний раз, преобразуйте имя пользователя в числовое значение UID, найдите соответствующую запись в файле, прочитайте и распакуйте данные. Средствами интерпретатора это сделать очень сложно, зато в программе laston все очень легко. Приведем пример:
% laston gnat gnat UID 314 at Mon May 25 08:32:52 1998 on ttypO from below.perl.com
Программа из примера 8.9 была написана гораздо позже программы tctee из примера 8.8, однако она менее переносима, поскольку в ней используется двоичная структура файла lastlog системы UNIX. Для других систем ее необходимо изменить.
Пример 8.9. laston
#!/usr/bin/perl
# laston - определение времени последней регистрации пользователя
use User::pwent;
use IO::Seekable qw(SEEK_SET);
open (LASTLOG, "/var/log/lastlog") or die "can't open /usr/adm/lastlog: $!";
$typedef = 'l a12 a16'; # Формат linux; для sunos - "l a8 a16' $sizeof =
length(pack($typedef, ()));
for $user (@ARGV) {
$U = ($user =~ /"\d+$/) ? getpwuid($user) : getpwnam($user);
unless ($U) { warn "no such uid $user\n"; next; }
seek(LASTLOG, $U->uid * $sizeof, SEEK_SET) or die "seek failed: $!
read(LASTLOG, Sbuffer, $sizeof) == $sizeof or next;
($time, $line, $host) = unpack($typedef, $buffer);
printf "%-8s UID %5d %s%s%s\n", $U->name, $U->uid,
$time ? ("at " . localtime($time)) : "never logged in",
$line && " on $line",
$host && " from $host";
}
