Приветствую тебя, любитель кодинга и извращений =). Сегодня мы будем изобретать велосипед, а именно переписывать часть небезызвестной программы wget. Зачем нам это нужно? Ну, во первых, пора наконец научиться кодить самостоятельно и юзать свои проекты в дальнейшем, а во вторых, быть может этот даунлоадер тебе может пригодиться. Первая его потребность, которая пришла мне в голову - закачка файлов, когда в системе не установлен wget и не работает (или запрещен) gcc. А тебе страсть как нужно скачать пару десятков видеофайлов на 600
мег (об их содержании я молчу ;)). Либо ты
зарутил систему в которой нет качалки, а пару логвайперов и руткитов тебе очень хочется скачать. Ситуаций может быть много, а выход один - использовать perl, так как его часто разрешают использовать на хостингах, да и вообще он установлен почти на всех машинах.
Даунлоадер работает по следующему принципу: читает файл с урлами (который берется либо из командной строки, либо под именем urls.txt), затем, используя LWP вытягивает его из инета и сохраняет в виде файла на HDD. Имя файла берется такое же, какое было на вебе. Все ссылки должны начинаться с http, иначе LWP не поймет протокола =). Конечно никто не запрещает тебе модифицировать скрипт с автоматическим добавлением http:// в начало ссылки, если ты очень ленивый.
В случае ошибки при скачивании (401, 403, 404, 500 и
т.д.) скрипт сообщит пользователю о неудаче и продолжит свою работу. Все файлы сохраняются в директории, откуда был запущен скрипт.
Итак, собственно сам скрипт с подробными комментариями:
#!/usr/bin/perl
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response; ## Юзаем модули LWP::UserAgent и запрос-ответ
http.
$|++; ## Отключаем буферизацию при выводе
$urls=shift || "urls.txt"; ## Берем за урл-файл параметр скрипта, либо статический urls.txt
open(URLS,$urls) || die "Usage: $0 <urlsfile>\n"; ## При неудаче - ругаемся 🙂
chomp(@urls=<URLS>); ## Накапливаем все урлы в массив
close(URLS);
foreach (@urls) {
$count++; ## Инкреминируем счетчик
$status=get($_); ## Качаем файло с веба
$status eq 1 ? print "File $name getted\n" : print "$error get: $_\n"; ## Если статус возврата 1, сообщаем об успешной закачке, иначе рисуем ошибку
}
exit print "Done $count files\n"; ## Выходим, скачав все
sub get { ## Процедура закачки файлов
my $file = shift; ## Файл - параметр
my $get=LWP::UserAgent->new(); ## Создаем объект LWP
$req=HTTP::Request->new(GET=>$file); ## Создаем реквест на GET файла
$response=$get->request($req); ## И качаем его с помощью LWP
if ($response->is_error()) { $error=$response->status_line; return 0 } ## Если произошла неудача, запоминаем ошибку и возвращаем 0
($name=$file)=~s(^.*/)(); ## Формируем локальное имя файла
open(DUMP,">$name"); ## Создаем файл с этим именем
binmode DUMP; ## Открываем бинарный режим (это очень важно!)
$an=$response->as_string; ## Запоминаем весь запрос одной строкой
chomp($an); ## Уменьшаем ее на предмет \n в конце
$an=~m/\n\n(.*)/s; ## Извлекаем из нее все после хеадера в $1 (флаг /s нужен для поддержки многострочного шаблона)
print DUMP $1; ## Записываем файл
close(DUMP);
return 1 ## Возвращаем успешный статус закачки
}
Вот и все. С таким раскладом скрипт работает на ура, и файлы скачиваются в точности такого же размера, что и были на вебе. У меня был примерно такой диалог:
[root@shell work]# perl get.pl
File mirc.zip getted
error an get http://www.xploits.net/rootkits/lkm.tgz: 401 Authorization Required
File foto.jpg getted
Done 3 files
Как видишь, все работает, как и было задумано. Можешь взять с полки пирожок за успех в кодинге :). И главное, никогда не останавливайся на достигнутом.
PS: Для ленивых людей: скрипт можно скачать по ссылке:
http://kamensk.net.ru/forb/1/getter.tar.gz.
