#!/usr/bin/perl # пересылка по E-Mail страницы HTML # Vladimir Maximenko 4raznoe@mail.ru use LWP::UserAgent; use MIME::Lite; use URI::URL; use HTML::LinkExtor; use Time::Local; # адрес для пересылки $to_email='4raznoe@im.kiev.ua'; # качаем с ANEKDOT.RU все истории за вчера $sutki=24*60*60; # сегодня ($tek_day,$tek_month,$tek_year)=(localtime)[3,4,5]; $in1=timelocal(0,0,0,$tek_day,$tek_month,$tek_year); # вчера $in2=$in1-$sutki; ($tek_day,$tek_month,$tek_year)=(localtime($in2))[3,4,5]; $tek_month++; $tek_year+=1900; # первый символ - 0 if ($tek_month<10) {$tek_month="0".$tek_month} if ($tek_day<10) {$tek_day="0".$tek_day;} $an_year=substr($tek_year, 2, 2); # страница для скачивания $url_page="http://www.anekdot.ru/an/an".$an_year.$tek_month."/o".$an_year.$tek_month.$tek_day.".html"; # скачиваем web страницу $ua = LWP::UserAgent->new; $ua->agent("Pilesosik ".$ua->agent); # прокси-сервер для локальной сети # $ua->proxy(['http', 'ftp'], 'http://10.0.0.3:3128/'); # качаем содержимое страницы if ($url_page && $url_page=~/^(https?|ftp|file|nntp):\/\//) { print "Get ", $url_page,"\n"; my $req = new HTTP::Request('GET' => $url_page); my $res = $ua->request($req); if (!$res->is_success) {print "Can't fetch $url_page (".$res->message.")\n";} else {$gabarit = $res->content;} $racinePage=$res->base; } else {$gabarit=$url_page;$racinePage="";} # определяем кодировку if ($gabarit=~m/content\=\"(.+?)\"/i) { $content_type=$1; } else { $content_type="text/html"; } # подключаем внешний CSS $gabarit = include_css($gabarit,$racinePage); # подключаем внешний Javascript $gabarit = include_javascript($gabarit,$racinePage); # изменяем путь в форме $gabarit = link_form($gabarit,$racinePage); # меняем что надо, для использования страницы из письма my $analyseur = HTML::LinkExtor->new; $analyseur->parse($gabarit); my @l = $analyseur->links; my (%images_read,%url_remplace); foreach my $url (@l) { my $urlAbs = URI::WithBase->new($$url[2],$racinePage)->abs; chomp $urlAbs; # меняем относительный путь в ссылках на абсолютный if ( ($$url[0] eq 'a') && ($$url[1] eq 'href') && ($$url[2]) && (($$url[2]!~m!^http://!) && ($$url[2]!~m!^mailto:!)) && (!$url_remplace{$urlAbs}) ) { $gabarit=~s/\s href= [\"']? $$url[2] [\"']?/ href="$urlAbs"/gimx; print "Replace ",$$url[2]," with ",$urlAbs,"\n"; $url_remplace{$urlAbs}=1; } # картинка в обоях elsif (($$url[1] eq 'background') && ($$url[2])) { my $v = "background=\"$urlAbs\""; $gabarit=~s/background=\"$$url[2]\"/$v/im; if (!$images_read{$urlAbs}) { $images_read{$urlAbs} = 1; push(@mail, create_image_part($urlAbs)); } } # все картинки на странице elsif ( ((lc($$url[0]) eq 'img') || (lc($$url[0]) eq 'src')) && (!$images_read{$urlAbs}) ) { $images_read{$urlAbs}=1; push(@mail, create_image_part($urlAbs)); } } # меняем относительный путь для картинок на абсолютный sub pattern_image { return ']*) src= (["']?)([^"'> ]*) (["']?)/pattern_image($1,$3,$racinePage)/iegx; # создаем MIME-Lite объект $mail=build_mime_object($gabarit,@mail); # отсылаем страницу # для локальной сети - адрес SMTP сервера # MIME::Lite->send('smtp', "10.0.0.1", Timeout=>60); MIME::Lite->send('smtp', "localhost", Timeout=>60); $mail->send(); print "Sending to $to_email - ok\n"; exit; # подключаем внешний CSS sub include_css { my ($gabarit,$root)=@_; sub pattern_css { my ($url,$milieu,$fin,$root)=@_; my $ur = URI::URL->new($url, $root)->abs; print "Include CSS file $ur\n"; my $res2 = $ua->request(new HTTP::Request('GET' => $ur)); return '\n"; } $gabarit=~s/]*?)href="?([^\" ]*)"?([^>]*)>/pattern_css($2,$1,$3,$root)/iegmx; print "Done CSS\n"; return $gabarit; } # подключаем внешний Javascript sub include_javascript { my ($gabarit,$root)=@_; sub pattern_js { my ($url,$milieu,$fin,$root)=@_; my $ur = URI::URL->new($url, $root)->abs; print "Include Javascript file $ur\n"; my $res2 = $ua->request(new HTTP::Request('GET' => $ur)); my $content = $res2->content; return "\n"."\n".'\n"; } $gabarit=~s/]*)src="?([^\" ]*js)"?([^>]*)>/pattern_js($2,$1,$3,$root)/iegmx; print "Done Javascript\n"; return $gabarit; } # изменяем путь в форме sub link_form { my ($gabarit,$root)=@_; sub pattern_link_form { my ($deb,$url,$fin,$base)=@_; my $type; my $ur = URI::URL->new($url, $base)->abs; return '
'; } $gabarit=~s/]*)action="?([^\"'> ]*)"?([^>]*)>/pattern_link_form($1,$2,$3,$root)/iegmx; print "Done form\n"; return $gabarit; } # закодированая картинка sub create_image_part { my ($ur)=@_; my ($type, $buff1); # тип MIME if (lc($ur)=~/gif$/) {$type="image/gif";} elsif (lc($ur)=~/jpg$/) {$type = "image/jpg";} else { $type = "application/x-shockwave-flash"; } # скачиваем картинку print "Get img ", $ur,"\n"; my $res2 = $ua->request(new HTTP::Request('GET' => $ur)); if (!$res2->is_success) {print "Can't get $ur\n";} $buff1=$res2->content; $file_name = substr($ur,rindex($ur,"/")+1,length($ur)); # кодируем очередную картинку my $mail = new MIME::Lite( Data => $buff1, Encoding =>'base64', 'Filename'=>$file_name); $mail->attr('Content-type'=>$type); $mail->attr('Content-Location'=>$ur); return $mail; } # создаем MIME объект sub build_mime_object { my ($html,@mail)=@_; # только HTML часть - создаем text/html $mail = new MIME::Lite 'From' => 'somebody@somewhere.com', 'To' => $to_email, 'Subject' => $url_page, 'Data' => $html; $mail->attr("Content-type" => $content_type); # если картинки+html, создаем multipart/related if (@mail) { $mail->replace("Type" => "multipart/related"); # присоеденяем каждую картинку foreach (@mail) {$mail->attach($_);} } return $mail; }