Posts Tagged ‘perl’

For fun.

Ноябрь 20th, 2009

Совсем недавно приходилось решать интересную задачу по Unix:
Фактически нужно было разработать демон simple-telnetd на языке Perl, позволяющий удалённо запускать некоторое ограниченное подмножество команд и выводить пользователю результат их выполнения.

  • simple-telnetd может запускать только разрешенные программы, которые перечислены в файле /etc/simple-telnetd.conf. Демон должен перечитывать этот файл и обновлять список разрешенных программ после поступления сигнала SIGHUP;
  • Запускаемые программы могут иметь параметры командной строки, но simple-telnetd не должен поддерживать интерактивного взаимодействия пользователя с запускаемыми программами;
  • Демон не обязан обрабатывать спец символы: ^C, ^D, и т.д.
  • В качестве параметра командной строки simple-telnetd может передаваться параметр timeout – максимальное время выполнения одной команды;
  • Желательно чтобы демон мог прослушивать не только tcp сокеты, но и локальные (например /tmp/simple-telnetd);

В конце-концов, скрипт всё же не пригодился, поэтому, чтобы компенсировать потраченное на него время, выкладываю его тут – вдруг, кому пригодится. Забрать его можно по этой ссылке.
simple-telnetd.tar.gz
Если кому-то помогло, пишите, не стесняйтесь, буду рад :) .

Поскольку я писал этот демон с особым энтузиазмом, не обошлось без фич, которых нет в исходном задании: написал init.d-скрипт для службы, который успешно был протестирован в openSUSE Linux, оформил perldoc и manpages, сделал возможность интерактивной авторизации, ну и другая мелочёвка (уже даже и не помню какая) вдовесок.

Hand-made синхронизация репозиториев Subversion

Март 29th, 2009

Несмотря на то, что репозиторий ОС XSystem мигрировал ко мне на домашний сервер, всё же хорошо было бы хранить бэкапы на каком-нибудь удалённом сервере.
Для этого я решил воспользоваться уже имеющимся репозиторием subversion на http://sourceforge.net/.

Идея работы такая: раз в сутки мой репозиторий должен синхронизироваться с удалённым репозиторием. При этом, все изменения в одном репозитории должны однозначно отражаться на другом. С версии subversion 1.4 появилась такая тулза, как svnsync, но она для моего случая не подходит: оба репозитория не предоставляют прямого доступа к svnroot.

Поэтому, немного порывшись в гугле, решил прибегнуть к собственному механизму синхронизации. Идея простая: раз в сутки сливается содержимое первого и второго (будем называть source и destination) репозитория. После этого сверяем содержимое source-репозитория с содержимым destination-репозитория: создаём несуществующие каталоги и копируем несуществующие файлы. Файлы, имеющие различные контрольные суммы md5, также перезаписываем. Но это не всё. После того, как мы влили новое файло в локальное дерево destination-репозитория, мы должны удалить из него те файлы, которых уже нет в source-репозитории. Для этого осуществляем обратную сверку снимка destination-репозитория с source-репозиторием и удаляем из него лишние файлы.

В результате всё это было сведено к скрипту на PERL.

#!/usr/bin/perl

use strict;

my @blacklist   =
(
    qr(^\.svn|\/\.svn$),
    qr(^\.{1,2}$|\/\.{1,2}$)
);

my $src_path  = 'xsystem';
my $dst_path  = 'xskernel-sync';
my $svn_user  = '';
my $svn_pass  = '';

# Update repositories
`svn update $src_path`;
`svn update $dst_path`;

# now search files in src_path and compare to dst_path

add_files();
remove_files();

`svn commit $dst_path -m "Synchronization commit" --username $svn_user --password $svn_pass`;

Как видно, работа скрипта достаточно примитивна. Для его работы нужно иметь два рабочих снимка репозитория: source и destination. У меня source-репозиторий находится в каталоге xsystem, а destination – в каталоге dst_path.
Скрипт сначала обновляет снимки репозиториев, затем осуществляет вливание новых файлов в destination-репозиторий при помощи функции add_files(). После этого удаляются устаревшие файлы и каталоги из destination-репозитория функцией remove_files() и производится коммит изменений в destination-репозиторий.

Дело осталось за малым – разобрать функции добавления и удаления файлов и каталогов. Для этого сначала напишем функцию, которая получает md5sum файла:

sub md5sum
{
    my $fname = shift;
    if (open PIPE, "md5sum $fname |")
    {
        my $line =
;
        close PIPE;
        my ($sum) = ($line =~ /^(\w+)\s+/o);
        return $sum;
    }
    return undef;
}

В принципе, ничего нового. Вызывается утилита md5sum и анализируется её вывод.

Также необходимо игнорировать каталоги ".svn", "." и "..", для чего вводится массив @blacklist и пишется функция банинга файлов:

sub ban_file
{
    my $src_file = shift;
    foreach (@blacklist)
    {
        ($src_file =~ $_) and
            return 1;
    }
    return undef;
}

После этого можно спокойно разобрать функцию add_files():


sub add_files
{
    my @directories = ();
    my $curr_dir = '';

    do
    {
        # Открываем каталог
        if (opendir DIRHDL, "$src_path$curr_dir")
        {
            CYCLE: # Читаем содержимое каталога
            while (my $fname = readdir DIRHDL)
            {
                # Баним ненужные файлы
                my $src_file = "$src_path$curr_dir/$fname";
                (ban_file($src_file)) and
                    next CYCLE;

                my $dst_short = "$curr_dir/$fname";
                my $dst_file  = "$dst_path$dst_short";

                # Файл является каталогом?
                if (-d $src_file)
                {
                    # необходимо проверить, что он есть в destination-репозитории
                    unless (-d $dst_file)
                    {
                        # если каталога нет - его нужно создать
                        print "mkdir   $dst_short\n";
                        `mkdir -p $dst_file`;
                        `svn add $dst_file`;
                    }

                    # Запомним каталог для того, чтобы в будущем его просмотреть
                    push @directories, $dst_short;
                }
                else
                {
                    # проверяем, существует ли файл в destination-репозитории
                    unless (-e $dst_file)
                    {
                        # файл не существует, его нужно скопировать и добавить
                        print "add     $dst_short\n";
                        `cp -f $src_file $dst_file`;
                        `svn add $dst_file`;
                    }
                    else
                    {
                        # файл существует, вычисляем md5sum обоих файлов
                        my $sum1 = md5sum($src_file);
                        my $sum2 = md5sum($dst_file);

                        # если суммы не совпадают - заменяем файл новым
                        if ($sum1 ne $sum2)
                        {
                            print "replace $dst_short\n";
                            `cp -f $src_file $dst_file`;
                        }
                    }
                }
            }
        }
        else
        {
            print "Can't open dir $src_path$curr_dir\n";
        }

        # закрываем каталог и получаем следующий каталог, который следует обработать
        closedir DIRHDL;
        $curr_dir = shift @directories;
    }
    while (defined $curr_dir); # крутимся, пока в списке присутствуют обрабатываемые каталоги.
}

При удалении функция будет очень похожа, только теперь надо осуществлять поиск файлов в destination-репозитории и смотреть, есть ли они в source-репозитории:

sub remove_files
{
    my @directories = ();
    my $curr_dir = '';

    do
    {
        # опять же, открываем каталог destination-репозитория
        if (opendir DIRHDL, "$dst_path$curr_dir")
        {
            CYCLE: # читаем файлы
            while (my $fname = readdir DIRHDL)
            {
                # баним недопустимые diren'ы
                my $src_file = "$dst_path$curr_dir/$fname";
                (ban_file($src_file))
                    and next CYCLE;

                my $src_short = "$curr_dir/$fname";
                my $dst_file  = "$src_path$src_short";

                # проверяем, является ли это каталогом
                if (-d $src_file)
                {
                    # проверяем, существует ли этот каталог в source-репозитории
                    unless (-d $dst_file)
                    {
                        # каталога нет - удаляем его из destination-репозитория
                        print "rmdir   $src_short\n";
                        `svn delete $src_file`;
                    }
                    else
                    {
                        # каталог существует, запоминаем его для дальнейшей обработки
                        push @directories, $src_short;
                    }
                }
                else
                {
                    # Это обычный файл, проверяем, есть ли он в source-репозитории
                    unless (-e $dst_file)
                    {
                        # Файла нет, удаляем его из destination-репозитория
                        print "unlink  $src_short\n";
                        `svn delete $src_file`;
                    }
                }
            }
        }
        else
        {
            print "Can't open dir $dst_path$curr_dir\n";
        }

        # Закрываем каталог, получаем следующий
        closedir DIRHDL;
        $curr_dir = shift @directories;
    }
    while (defined $curr_dir);
}

Недостаток этой тулзы один: если файл был перемещён, то он будет распознан как новый файл. Хотя, я не думаю, что файлы и каталоги так часто перемещаются в логически корректно построенном дереве проекта.

Статистика.

Январь 11th, 2009

Стремление товарища mar1ner  наблюдать за поисковыми запросами также сподвигло меня на идею написания скрипта, который составлял бы суточную статистику переходов по поисковым запросам на мой сервер. Скрипт запускается в час ночи по локальному времени (cron) и собирает информацию за прошедшие сутки. Запуск в час ночи сделал с поправкой на переход с летнего времени на зимнее и обратно ;) , на всякий пожарный.

Собственно, сам скрипт выглядит так:
Пара страничек кода…