Приветствую тебя, любитель кодинга и извращений =). Сегодня мы будем изобретать велосипед, а именно переписывать часть небезызвестной программы 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.

Оставить мнение

Check Also

Безумный олдскул. Самые необычные приставки и игровые аксессуары из прошлого

Если ты думаешь, что Guitar Hero, Kinect или Wii Remote — это странно, то спешим тебя заве…