User Tools

Site Tools


Sidebar

Eventsupport

Sponsors

Interested in supporting an Open Source Camp? Get in touch: unfuck[at]unfuck[dot]eu

Predecessors

$RANDOM

archive:2011:slides:wos

Web of Services aka Wall of Shame

Ergebnis

Code

use Sniffer::HTTP ;
use IO::Uncompress::Gunzip qw(gunzip $GunzipError) ;
use Image::Magick ;
use Switch ;
use Net::Pcap::FindDevice ;
 
 
opendir(dir,'/srv/http/pics/');
@files = readdir(dir);
@sorted = sort { $a <=> $b } @files;
$num = 0;
if ($sorted[-1] =~ m/(\d+)/) {
        $num = $1+1;
}
close dir;
 
sub process {
   my $type;
   my ($data) = @_;
   my $image = Image::Magick->new;
   $err = $image->BlobToImage( ($data) );
   $type = is_image($image);
   return unless $type;
   my $height = $image->Get('height');
   my $width = $image->Get('width');
   if ($height < 65 || $width <65)
   {
      print "skipping, image too small\n";
      return;
   }
   if ($height > 200)
   {
        $image->Resize('x200');
   }
  if ($width > 500)
   {
        $image->Resize('500x');
   }
   print "writing $num.$type\n";
   $image->Write("/srv/http/pics/$num.$type");
   $num++;
}
 
sub is_image {
   my ($image) = @_;
   switch ($image->Get('magick')) {
      case /PNG/ { return 'png'; }
      case /GIF/ { return 'gif'; }
      case /JPEG/ { return 'jpg'; }
      else { return 0; }
   }
}
 
$sniffer = Sniffer::HTTP->new(
      callbacks => {
#request => sub { my ($req,$conn) = @_; print "Request: ",$req->$uri,"\n" if $req },
        response => sub { my ($res,$req,$conn) = @_;
                          my $data;
#                          print "Response: ",$res->code,"\n";
                          return unless $res->code == 200;
 
                          if ($res->header('Content-Encoding') =~ /gzip/)
                          {
                              gunzip \$res->content => \$data;
                          }
                          else
                          {
                              $data = $res->content;
                          }
                          process($data);
                        },
      },
      timeout => 5*60,
      stale_connection
         => sub { my ($s,$conn,$key) = @_;
                  $s->remove_connection($key);
                },
);
 
my $device = find_device('eth5.5');
print "$device\n";
$sniffer->run($device);

Infrastruktur

archive/2011/slides/wos.txt · Last modified: 2016/03/23 12:52 by luke