X-Git-Url: http://git.hungrycats.org/cgi-bin/gitweb.cgi?p=xscreensaver;a=blobdiff_plain;f=hacks%2Fwebcollage;h=d7764e08e7ea645bc983ef9016bf7176b0b533b9;hp=f77c6153500a83fdfacf12671d7e118390083077;hb=ffd8c0873576a9e3065696a624dce6b766b77062;hpb=3c58fb6311db49c46f1670922933b27c6ea0c065 diff --git a/hacks/webcollage b/hacks/webcollage index f77c6153..d7764e08 100755 --- a/hacks/webcollage +++ b/hacks/webcollage @@ -1,6 +1,6 @@ #!/usr/bin/perl -w # -# webcollage, Copyright (c) 1999-2001 by Jamie Zawinski +# webcollage, Copyright (c) 1999-2004 by Jamie Zawinski # This program decorates the screen with random images from the web. # One satisfied customer described it as "a nonstop pop culture brainbath." # @@ -9,13 +9,34 @@ # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation. No representations are made about the suitability of this -# software for any purpose. It is provided "as is" without express or +# software for any purpose. It is provided "as is" without express or # implied warranty. + # To run this as a display mode with xscreensaver, add this to `programs': # -# default-n: webcollage -root \n\ -# default-n: webcollage -root -filter 'vidwhacker -stdin -stdout' \n\ +# webcollage -root +# webcollage -root -filter 'vidwhacker -stdin -stdout' +# +# +# You can see this in action at http://www.jwz.org/webcollage/ -- +# it auto-reloads about once a minute. To make a page similar to +# that on your own system, do this: +# +# webcollage -size '800x600' -imagemap $HOME/www/webcollage/index +# +# +# If you have the "driftnet" program installed, webcollage can display a +# collage of images sniffed off your local ethernet, instead of pulled out +# of search engines: in that way, your screensaver can display the images +# that your co-workers are downloading! +# +# Driftnet is available here: http://www.ex-parrot.com/~chris/driftnet/ +# Use it like so: +# +# webcollage -root -driftnet +# +# Driftnet is the Unix implementation of the MacOS "EtherPEG" program. require 5; @@ -33,38 +54,59 @@ require POSIX; use Fcntl ':flock'; # import LOCK_* constants use POSIX qw(strftime); +use bytes; # Larry can take Unicode and shove it up his ass sideways. + # Perl 5.8.0 causes us to start getting incomprehensible + # errors about UTF-8 all over the place without this. + my $progname = $0; $progname =~ s@.*/@@g; -my $version = q{ $Revision: 1.77 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; -my $copyright = "WebCollage $version, Copyright (c) 1999-2001" . +my $version = q{ $Revision: 1.117 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/; +my $copyright = "WebCollage $version, Copyright (c) 1999-2004" . " Jamie Zawinski \n" . - " http://www.jwz.org/xscreensaver/\n"; - - - -my @search_methods = ( 35, "imagevista", \&pick_from_alta_vista_images, - 33, "altavista", \&pick_from_alta_vista_text, - 20, "yahoorand", \&pick_from_yahoo_random_link, - 2, "yahoonews", \&pick_from_yahoo_news_text, - 10, "lycos", \&pick_from_lycos_text, - - # Hotbot gives me "no matches" just about every time. - # Then I try the same URL again, and it works. I guess - # it caches searches, and webcollage always busts its - # cache and time out? Or it just sucks. - # 0, "hotbot", \&pick_from_hotbot_text, + " http://www.jwz.org/webcollage/\n"; + + + +my @search_methods = ( 71, "altavista", \&pick_from_alta_vista_random_link, + 10, "livejournal", \&pick_from_livejournal_images, + 8, "yahoorand", \&pick_from_yahoo_random_link, + 6, "yahoonews", \&pick_from_yahoo_news_text, + 5, "ircimages", \&pick_from_ircimages, + + # Alta Vista has a new "random link" URL now. + # They added it specifically to better support webcollage! + # That was super cool of them. This is how we used to do + # it, before: + # + # 0, "avimages", \&pick_from_alta_vista_images, + # 0, "avtext", \&pick_from_alta_vista_text, + + # Google asked (nicely) for me to stop searching them. + # I asked them to add a "random link" url. They said + # "that would be easy, we'll think about it" and then + # never wrote back. Booo Google! Booooo! + # + # 0, "googlenums", \&pick_from_google_image_numbers, + # 0, "googleimgs", \&pick_from_google_images, + + # I suspect Hotbot is actually the same search engine + # data as Lycos. + # + # 0, "hotbot", \&pick_from_hotbot_text, + + # Eh, Lycos sucks anyway. + # 0, "lycos", \&pick_from_lycos_text, ); -#@search_methods=(100, "lycos", \&pick_from_lycos_text); - # programs we can use to write to the root window (tried in ascending order.) # -my @root_displayers = ( - "xloadimage -quiet -onroot -center -border black", - "xli -quiet -onroot -center -border black", - "xv -root -quit -viewonly +noresetroot -rmode 5" . +my @root_displayers = ( + "xscreensaver-getimage -root -file", + "chbg -once -xscreensaver -max_size 100", + "xv -root -quit -viewonly +noresetroot -quick24 -rmode 5" . " -rfg black -rbg black", - "chbg -once -xscreensaver", + "xli -quiet -onroot -center -border black", + "xloadimage -quiet -onroot -center -border black", # this lame program wasn't built with vroot.h: # "xsri -scale -keep-aspect -center-horizontal -center-vertical", @@ -77,13 +119,29 @@ my %cookies = ( "www.altavista.com" => "AV_ALL=1", # request uncensored searches "web.altavista.com" => "AV_ALL=1", - # log in as "cpunks" - "www.nytimes.com" => "NYT-S=104nv1sChNnnWAvTLGx6eiDhzQcbSoN" . - "6zOMB7s0Qm8MlMaa8It.2/BlXTrpbBk" . - "jinV68IcqxOvAABDyKdciIJ8O000", + # log in as "cipherpunk" + "www.nytimes.com" => 'NYT-S=18cHMIlJOn2Y1bu5xvEG3Ufuk6E1oJ.' . + 'FMxWaQV0igaB5Yi/Q/guDnLeoL.pe7i1oakSb' . + '/VqfdUdb2Uo27Vzt1jmPn3cpYRlTw9', + + "ircimages.com" => 'disclaimer=1', ); +# If this is set, it's a helper program to use for pasting images together: +# this is a lot faster and more efficient than using PPM pipelines, which is +# what we do if this program doesn't exist. (We check for "webcollage-helper" +# on $PATH at startup, and set this variable appropriately.) +# +my $webcollage_helper = undef; + + +# If we have the webcollage-helper program, then it will paste the images +# together with transparency! 0.0 is invisible, 1.0 is totally opaque. +# +my $opacity = 0.85; + + # Some sites have managed to poison the search engines. These are they. # (We auto-detect sites that have poisoned the search engines via excessive # keywords or dictionary words, but these are ones that slip through @@ -93,13 +151,20 @@ my %cookies = ( # my %poisoners = ( "die.net" => 1, # 'l33t h4ck3r d00dz. - "genforum.genealogy.com" => 1, # Cluttering altavista with human names. - "rootsweb.com" => 1, # Cluttering altavista with human names. + "genforum.genealogy.com" => 1, # Cluttering avtext with human names. + "rootsweb.com" => 1, # Cluttering avtext with human names. "akamai.net" => 1, # Lots of sites have their images on Akamai. - # But those are pretty much all banners. + "akamaitech.net" => 1, # But those are pretty much all banners. # Since Akamai is super-expensive, let's # go out on a limb and assume that all of # their customers are rich-and-boring. + "bartleby.com" => 1, # Dictionary, cluttering avtext. + "encyclopedia.com" => 1, # Dictionary, cluttering avtext. + "onlinedictionary.datasegment.com" => 1, # Dictionary, cluttering avtext. + "hotlinkpics.com" => 1, # Porn site that has poisoned avimages + # (I don't see how they did it, though!) + "alwayshotels.com" => 1, # Poisoned Lycos pretty heavily. + "nextag.com" => 1, # Poisoned Alta Vista real good. ); @@ -118,6 +183,8 @@ my %warningless_sites = ( "yimg.com" => 1, # This is where dailynews.yahoo.com stores "eimg.com" => 1, # its images, so pick_from_yahoo_news_text() # hits this every time. + + "driftnet" => 1, # builtin... ); @@ -153,18 +220,20 @@ my $min_width = 50; my $min_height = 50; my $min_ratio = 1/5; +my $min_gif_area = (120 * 120); + + my $no_output_p = 0; my $urls_only_p = 0; +my $imagemap_base = undef; -my $wordlist = "/usr/dict/words"; +my @pids_to_kill = (); # forked pids we should kill when we exit, if any. -if (!-r $wordlist) { - $wordlist = "/usr/share/dict/words"; # BSD -} -if (!-r $wordlist) { - $wordlist = "/usr/share/lib/dict/words"; # Irix -} -die "$progname: $wordlist doesn't exist!\n" unless (-r $wordlist); +my $driftnet_magic = 'driftnet'; +my $driftnet_dir = undef; +my $default_driftnet_cmd = "driftnet -a -m 100"; + +my $wordlist; my %rejected_urls; my @tripwire_words = ("aberrate", "abode", "amorphous", "antioch", @@ -204,6 +273,11 @@ sub get_document_1 { my ($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4); $path = "" unless $path; + if (!$url_proto || !$serverstring) { + LOG (($verbose_net || $verbose_load), "unparsable URL: $url"); + return (); + } + my ($them,$port) = split(/:/, $serverstring); $port = 80 unless $port; @@ -211,6 +285,7 @@ sub get_document_1 { my $port2 = $port; if ($http_proxy) { $serverstring = $http_proxy if $http_proxy; + $serverstring =~ s@^[a-z]+://@@; ($them2,$port2) = split(/:/, $serverstring); $port2 = 80 unless $port2; } @@ -255,16 +330,24 @@ sub get_document_1 { my $cookie = $cookies{$them}; + my $user_agent = "$progname/$version"; + + if ($url =~ m@^http://www\.altavista\.com/@ || + $url =~ m@^http://random\.yahoo\.com/@ || + $url =~ m@^http://images\.google\.com/@) { + # block this, you turkeys. + $user_agent = "Mozilla/4.76 [en] (X11; U; Linux 2.2.16-22 i686; Nav)"; + } + my $hdrs = "GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" . "Host: $them\r\n" . - "User-Agent: $progname/$version\r\n"; + "User-Agent: $user_agent\r\n"; if ($referer) { $hdrs .= "Referer: $referer\r\n"; } if ($cookie) { - foreach (split(/\r?\n/, $cookie)) { - $hdrs .= "Cookie: $_\r\n"; - } + my @cc = split(/\r?\n/, $cookie); + $hdrs .= "Cookie: " . join('; ', @cc) . "\r\n"; } $hdrs .= "\r\n"; @@ -272,7 +355,12 @@ sub get_document_1 { LOG ($verbose_http, " ==> $_"); } print S $hdrs; - my $http = ; + my $http = || ""; + + # Kludge: the Yahoo Random Link is now returning as its first + # line "Status: 301" instead of "HTTP/1.0 301 Found". Fix it... + # + $http =~ s@^Status:\s+(\d+)\b@HTTP/1.0 $1@i; $_ = $http; s/[\r\n]+$//s; @@ -329,6 +417,10 @@ sub get_document { my ( $url, $referer, $timeout ) = @_; my $start = time; + if (defined($referer) && $referer eq $driftnet_magic) { + return get_driftnet_file ($url); + } + my $orig_url = $url; my $loop_count = 0; my $max_loop_count = 4; @@ -355,6 +447,7 @@ sub get_document { if ( $http =~ m@^HTTP/[0-9.]+ 30[123]@ ) { $_ = $head; + my ( $location ) = m@^location:[ \t]*(.*)$@im; if ( $location ) { $location =~ s/[\r\n]$//; @@ -473,9 +566,9 @@ sub pick_image_from_body { # randomly from the set of images on the web. All the logic here for # rejecting some images is really a set of heuristics for rejecting # images that are not really images: for rejecting *text* that is in - # GIF/JPEG form. I don't want text, I want pictures, and I want the - # content of the pictures to be randomly selected from among all the - # available content. + # GIF/JPEG/PNG form. I don't want text, I want pictures, and I want + # the content of the pictures to be randomly selected from among all + # the available content. # # So, filtering out "dirty" pictures by looking for "dirty" keywords # would be wrong: dirty pictures exist, like it or not, so webcollage @@ -533,7 +626,7 @@ sub pick_image_from_body { } elsif ( m/^(img|a) .*(src|href) ?= ?\"? ?(.*?)[ >\"]/io ) { - my $was_inline = ( "$1" eq "a" || "$1" eq "A" ); + my $was_inline = (! ( "$1" eq "a" || "$1" eq "A" )); my $link = $3; my ( $width ) = m/width ?=[ \"]*(\d+)/oi; my ( $height ) = m/height ?=[ \"]*(\d+)/oi; @@ -546,8 +639,7 @@ sub pick_image_from_body { } elsif ( ! m@^[^/:?]+:@ ) { $_ = "$base$link"; s@/\./@/@g; - while (s@/\.\./@/@g) { - } + 1 while (s@/[^/]+/\.\./@/@g); } # skip non-http @@ -556,7 +648,7 @@ sub pick_image_from_body { } # skip non-image - if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg)$@io ) { + if ( ! m@[.](gif|jpg|jpeg|pjpg|pjpeg|png)$@io ) { next; } @@ -581,6 +673,15 @@ sub pick_image_from_body { next; } + # skip GIFs with a small number of pixels -- those usually suck. + if ($width && $height && + m/\.gif$/io && + ($width * $height) < $min_gif_area) { + LOG ($verbose_filter, " skip small GIF $_ (${width}x$height)"); + next; + } + + my $url = $_; if ($unique_urls{$url}) { @@ -589,16 +690,16 @@ sub pick_image_from_body { } LOG ($verbose_filter, - " image $url" . + " image $url" . ($width && $height ? " (${width}x${height})" : "") . ($was_inline ? " (inline)" : "")); $urls[++$#urls] = $url; $unique_urls{$url}++; - # jpegs are preferable to gifs. + # JPEGs are preferable to GIFs and PNGs. $_ = $url; - if ( ! m@[.]gif$@io ) { + if ( ! m@[.](gif|png)$@io ) { $urls[++$#urls] = $url; } @@ -615,13 +716,13 @@ sub pick_image_from_body { $_ = undef; $body = undef; + @urls = depoison (@urls); + if ( $#urls < 0 ) { LOG ($verbose_load, "no images on $base" . ($fsp ? " (frameset)" : "")); return (); } - @urls = depoison (@urls); - # pick a random element of the table my $i = int(rand($#urls+1)); $url = $urls[$i]; @@ -640,10 +741,22 @@ sub pick_image_from_body { ############################################################################ +sub pick_dictionary { + my @dicts = ("/usr/dict/words", + "/usr/share/dict/words", + "/usr/share/lib/dict/words"); + foreach my $f (@dicts) { + if (-f $f) { + $wordlist = $f; + last; + } + } + error ("$dicts[0] does not exist") unless defined($wordlist); +} + # returns a random word from the dictionary # sub random_word { - my $word = 0; if (open (IN, "<$wordlist")) { my $size = (stat(IN))[7]; @@ -679,14 +792,48 @@ sub random_word { } sub random_words { - return (random_word . "%20" . - random_word . "%20" . - random_word . "%20" . - random_word . "%20" . + my ($or_p) = @_; + my $sep = ($or_p ? "%20OR%20" : "%20"); + return (random_word . $sep . + random_word . $sep . + random_word . $sep . + random_word . $sep . random_word); } +sub url_quote { + my ($s) = @_; + $s =~ s|([^-a-zA-Z0-9.\@/_\r\n])|sprintf("%%%02X", ord($1))|ge; + return $s; +} + +sub url_unquote { + my ($s) = @_; + $s =~ s/[+]/ /g; + $s =~ s/%([a-z0-9]{2})/chr(hex($1))/ige; + return $s; +} + +sub html_quote { + my ($s) = @_; + $s =~ s/&/&/gi; + $s =~ s//>/gi; + $s =~ s/\"/"/gi; + return $s; +} + +sub html_unquote { + my ($s) = @_; + $s =~ s/</((\d{1,3})(,\d{3})*)<@i) { # googleimages + $search_count = $1; + } elsif ($body =~ m@((\d{1,3})(,\d{3})*) Web sites were found@i) { + $search_count = $1; # lycos } elsif ($body =~ m@WEB.*?RESULTS.*?\b((\d{1,3})(,\d{3})*)\b.*?Matches@i) { $search_count = $1; # hotbot - } elsif ($body =~ m@no photos were found containing@i) { # imagevista + } elsif ($body =~ m@no photos were found containing@i) { # avimages $search_count = "0"; - } elsif ($body =~ m@found no document matching@i) { # altavista + } elsif ($body =~ m@found no document matching@i) { # avtext $search_count = "0"; } 1 while ($search_count =~ s/^(\d+)(\d{3})/$1,$2/); @@ -873,7 +1026,7 @@ sub pick_image_from_pages { ############################################################################ # yahoorand -my $yahoo_random_link = "http://random.yahoo.com/bin/ryl"; +my $yahoo_random_link = "http://random.yahoo.com/fast/ryl"; # Picks a random page; picks a random image on that page; @@ -896,7 +1049,51 @@ sub pick_from_yahoo_random_link { return; } - LOG ($verbose_load, "redirected to: $base"); + LOG ($verbose_load, "redirected to: $base"); + + my $img = pick_image_from_body ($base, $body); + $body = undef; + + if ($img) { + return ($base, $img); + } else { + return (); + } +} + + +############################################################################ +# +# Pick images from random pages returned by the Alta Vista Random Link +# +############################################################################ + +# altavista +my $alta_vista_random_link = "http://www.altavista.com/image/randomlink"; + + +# Picks a random page; picks a random image on that page; +# returns two URLs: the page containing the image, and the image. +# Returns () if nothing found this time. +# +sub pick_from_alta_vista_random_link { + my ( $timeout ) = @_; + + print STDERR "\n\n" if ($verbose_load); + LOG ($verbose_load, "URL: $alta_vista_random_link"); + + $last_search = $alta_vista_random_link; # for warnings + + $suppress_audit = 1; + + my ( $base, $body ) = get_document ($alta_vista_random_link, + undef, $timeout); + if (!$base || !$body) { + $body = undef; + return; + } + + LOG ($verbose_load, "redirected to: $base"); my $img = pick_image_from_body ($base, $body); $body = undef; @@ -916,23 +1113,20 @@ sub pick_from_yahoo_random_link { ############################################################################ -my $alta_vista_images_url = "http://www.altavista.com/cgi-bin/query" . +my $alta_vista_images_url = "http://www.altavista.com/image/results" . "?ipht=1" . # photos "&igrph=1" . # graphics "&iclr=1" . # color "&ibw=1" . # b&w "&micat=1" . # no partner sites - "&imgset=1" . # no partner sites - "&stype=simage" . # do image search - "&mmW=1" . # unknown, but required + "&sc=on" . # "site collapse" "&q="; - -# imagevista +# avimages sub pick_from_alta_vista_images { my ( $timeout ) = @_; - my $words = random_words; + my $words = random_word(); my $page = (int(rand(9)) + 1); my $search_url = $alta_vista_images_url . $words; @@ -946,8 +1140,14 @@ sub pick_from_alta_vista_images { my @candidates = (); foreach my $u (@subpages) { + + # avimages is encoding their URLs now. + next unless ($u =~ s/^.*\*\*(http%3a.*$)/$1/gsi); + $u = url_unquote($u); + next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs next if ($u =~ m@[/.]altavista\.com\b@i); # skip altavista builtins + next if ($u =~ m@[/.]yahoo\.com\b@i); # yahoo and av in cahoots? next if ($u =~ m@[/.]doubleclick\.net\b@i); # you cretins next if ($u =~ m@[/.]clicktomarket\.com\b@i); # more cretins @@ -963,6 +1163,116 @@ sub pick_from_alta_vista_images { } + +############################################################################ +# +# Pick images by feeding random words into Google Image Search. +# By Charles Gales +# +############################################################################ + + +my $google_images_url = "http://images.google.com/images" . + "?site=images" . # photos + "&btnG=Search" . # graphics + "&safe=off" . # no screening + "&imgsafe=off" . + "&q="; + +# googleimgs +sub pick_from_google_images { + my ( $timeout ) = @_; + + my $words = random_word; # only one word for Google + my $page = (int(rand(9)) + 1); + my $num = 20; # 20 images per page + my $search_url = $google_images_url . $words; + + if ($page > 1) { + $search_url .= "&start=" . $page*$num; # page number + $search_url .= "&num=" . $num; #images per page + } + + my ($search_hit_count, @subpages) = + pick_from_search_engine ($timeout, $search_url, $words); + + my @candidates = (); + foreach my $u (@subpages) { + next unless ($u =~ m@imgres\?imgurl@i); # All pics start with this + next if ($u =~ m@[/.]google\.com\b@i); # skip google builtins + + if ($u =~ m@^/imgres\?imgurl=(.*?)\&imgrefurl=(.*?)\&@) { + my $urlf = $2; + LOG ($verbose_filter, " candidate: $urlf"); + push @candidates, $urlf; + } + } + + return pick_image_from_pages ($search_url, $search_hit_count, $#subpages+1, + $timeout, @candidates); +} + + + +############################################################################ +# +# Pick images by feeding random *numbers* into Google Image Search. +# By jwz, suggested by Ian O'Donnell. +# +############################################################################ + + +# googlenums +sub pick_from_google_image_numbers { + my ( $timeout ) = @_; + + my $max = 9999; + my $number = int(rand($max)); + + $number = sprintf("%04d", $number) + if (rand() < 0.3); + + my $words = "$number"; + my $page = (int(rand(40)) + 1); + my $num = 20; # 20 images per page + my $search_url = $google_images_url . $words; + + if ($page > 1) { + $search_url .= "&start=" . $page*$num; # page number + $search_url .= "&num=" . $num; #images per page + } + + my ($search_hit_count, @subpages) = + pick_from_search_engine ($timeout, $search_url, $words); + + my @candidates = (); + my %referers; + foreach my $u (@subpages) { + next unless ($u =~ m@imgres\?imgurl@i); # All pics start with this + next if ($u =~ m@[/.]google\.com\b@i); # skip google builtins + + if ($u =~ m@^/imgres\?imgurl=(.*?)\&imgrefurl=(.*?)\&@) { + my $ref = $2; + my $img = $1; + $img = "http://$img" unless ($img =~ m/^http:/i); + + LOG ($verbose_filter, " candidate: $ref"); + push @candidates, $img; + $referers{$img} = $ref; + } + } + + @candidates = depoison (@candidates); + return () if ($#candidates < 0); + my $i = int(rand($#candidates+1)); + my $img = $candidates[$i]; + my $ref = $referers{$img}; + + LOG ($verbose_load, "picked image " . ($i+1) . ": $img (on $ref)"); + return ($ref, $img); +} + + ############################################################################ # @@ -971,14 +1281,19 @@ sub pick_from_alta_vista_images { ############################################################################ -my $alta_vista_url = "http://www.altavista.com/cgi-bin/query?pg=q" . - "&text=yes&kl=XX&stype=stext&q="; +my $alta_vista_url = "http://www.altavista.com/web/results" . + "?pg=aq" . + "&aqmode=s" . + "&filetype=html" . + "&sc=on" . # "site collapse" + "&nbq=50" . + "&aqo="; -# altavista +# avtext sub pick_from_alta_vista_text { my ( $timeout ) = @_; - my $words = random_words; + my $words = random_words(0); my $page = (int(rand(9)) + 1); my $search_url = $alta_vista_url . $words; @@ -998,8 +1313,12 @@ sub pick_from_alta_vista_text { # onMouseOver to make it look like they're not! Well, it makes it # easier for us to identify search results... # - next unless ($u =~ m@^/r\?ck_sm=[a-zA-Z0-9]+\&ref=[a-zA-Z0-9]+\&r=(.*)@); - $u = $1; + next unless ($u =~ s/^.*\*\*(http%3a.*$)/$1/gsi); + $u = url_unquote($u); + + next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs + next if ($u =~ m@[/.]altavista\.com\b@i); # skip altavista builtins + next if ($u =~ m@[/.]yahoo\.com\b@i); # yahoo and av in cahoots? LOG ($verbose_filter, " candidate: $u"); push @candidates, $u; @@ -1017,23 +1336,30 @@ sub pick_from_alta_vista_text { # ############################################################################ -my $hotbot_search_url = "http://hotbot.lycos.com/" . - "?SM=SC" . - "&DV=0" . - "&LG=any" . - "&FVI=1" . - "&DC=100" . - "&DE=0" . - "&SQ=1" . - "&TR=13" . - "&AM1=MC" . - "&MT="; +my $hotbot_search_url =("http://hotbot.lycos.com/default.asp" . + "?ca=w" . + "&descriptiontype=0" . + "&imagetoggle=1" . + "&matchmode=any" . + "&nummod=2" . + "&recordcount=50" . + "&sitegroup=1" . + "&stem=1" . + "&cobrand=undefined" . + "&query="); sub pick_from_hotbot_text { my ( $timeout ) = @_; - my $words = random_words; - my $search_url = $hotbot_search_url . $words; + $last_search = $hotbot_search_url; # for warnings + + # lycos seems to always give us back dictionaries and word lists if + # we search for more than one word... + # + my $words = random_word(); + + my $start = int(rand(8)) * 10 + 1; + my $search_url = $hotbot_search_url . $words . "&first=$start&page=more"; my ($search_hit_count, @subpages) = pick_from_search_engine ($timeout, $search_url, $words); @@ -1042,8 +1368,14 @@ sub pick_from_hotbot_text { foreach my $u (@subpages) { # Hotbot plays redirection games too - next unless ($u =~ m@^/director.asp\?target=([^&]+)@); - $u = url_decode($1); + # (not any more?) +# next unless ($u =~ m@/director.asp\?.*\btarget=([^&]+)@); +# $u = url_decode($1); + + next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs + next if ($u =~ m@[/.]hotbot\.com\b@i); # skip hotbot builtins + next if ($u =~ m@[/.]lycos\.com\b@i); # skip hotbot builtins + next if ($u =~ m@[/.]inktomi\.com\b@i); # skip hotbot builtins LOG ($verbose_filter, " candidate: $u"); push @candidates, $u; @@ -1061,17 +1393,24 @@ sub pick_from_hotbot_text { # ############################################################################ -my $lycos_search_url = "http://lycospro.lycos.com/srchpro/" . +my $lycos_search_url = "http://search.lycos.com/default.asp" . "?lpv=1" . - "&t=any" . + "&loc=searchhp" . + "&tab=web" . "&query="; sub pick_from_lycos_text { my ( $timeout ) = @_; - my $words = random_words; + $last_search = $lycos_search_url; # for warnings + + # lycos seems to always give us back dictionaries and word lists if + # we search for more than one word... + # + my $words = random_word(); + my $start = int(rand(8)) * 10 + 1; - my $search_url = $lycos_search_url . $words . "&start=$start"; + my $search_url = $lycos_search_url . $words . "&first=$start&page=more"; my ($search_hit_count, @subpages) = pick_from_search_engine ($timeout, $search_url, $words); @@ -1079,11 +1418,21 @@ sub pick_from_lycos_text { my @candidates = (); foreach my $u (@subpages) { - # Lycos plays exact the same redirection game as hotbot. - # Note that "id=0" is used for internal advertising links, - # and 1+ are used for search results. - next unless ($u =~ m@^http://click.hotbot.com/director.asp\?id=[1-9]\d*&target=([^&]+)@); - $u = url_decode($1); + # Lycos plays redirection games. + # (not any more?) +# next unless ($u =~ m@^http://click.lycos.com/director.asp +# .* +# \btarget=([^&]+) +# .* +# @x); +# $u = url_decode($1); + + next unless ($u =~ m@^http://@i); # skip non-HTTP or relative URLs + next if ($u =~ m@[/.]hotbot\.com\b@i); # skip lycos builtins + next if ($u =~ m@[/.]lycos\.com\b@i); # skip lycos builtins + next if ($u =~ m@[/.]terralycos\.com\b@i); # skip lycos builtins + next if ($u =~ m@[/.]inktomi\.com\b@i); # skip lycos builtins + LOG ($verbose_filter, " candidate: $u"); push @candidates, $u; @@ -1101,14 +1450,23 @@ sub pick_from_lycos_text { # ############################################################################ -my $yahoo_news_url = "http://search.news.yahoo.com/search/news_photos?" . - "&z=&n=100&o=o&2=&3=&p="; +my $yahoo_news_url = "http://search.news.yahoo.com/search/news" . + "?a=1" . + "&c=news_photos" . + "&s=-%24s%2C-date" . + "&n=100" . + "&o=o" . + "&2=" . + "&3=" . + "&p="; # yahoonews sub pick_from_yahoo_news_text { my ( $timeout ) = @_; - my $words = random_words; + $last_search = $yahoo_news_url; # for warnings + + my $words = random_words(0); my $search_url = $yahoo_news_url . $words; my ($search_hit_count, @subpages) = @@ -1117,7 +1475,8 @@ sub pick_from_yahoo_news_text { my @candidates = (); foreach my $u (@subpages) { # only accept URLs on Yahoo's news site - next unless ($u =~ m@^http://dailynews.yahoo.com/@i); + next unless ($u =~ m@^http://dailynews\.yahoo\.com/@i || + $u =~ m@^http://story\.news\.yahoo\.com/@i); LOG ($verbose_filter, " candidate: $u"); push @candidates, $u; @@ -1128,6 +1487,214 @@ sub pick_from_yahoo_news_text { } + +############################################################################ +# +# Pick images from LiveJournal's list of recently-posted images. +# +############################################################################ + +my $livejournal_img_url = "http://www.livejournal.com/stats/latest-img.bml"; + +# livejournal +sub pick_from_livejournal_images { + my ( $timeout ) = @_; + + $last_search = $livejournal_img_url; # for warnings + + my ( $base, $body ) = get_document ($livejournal_img_url, undef, $timeout); + return () unless $body; + + my @candidates = (); + + $body =~ s/\n/ /gs; + $body =~ s/(]+)>@i; + next unless $u; + + if ($u =~ m/^\"([^\"]*)\"/) { $u = $1; } # quoted string + elsif ($u =~ m/^([^\s]*)\s/) { $u = $1; } # or token + + next unless ($u =~ m/^http:/i); + next if ($u =~ m@^http://(searchirc\.com\|ircimages\.com)@i); + next unless ($u =~ m@[.](gif|jpg|jpeg|pjpg|pjpeg|png)$@i); + + LOG ($verbose_http, " HREF: $u"); + push @candidates, $u; + } + + LOG ($verbose_filter, "" . $#candidates+1 . " links on $search_url"); + + return () if ($#candidates == -1); + + my $i = int(rand($#candidates+1)); + my $img = $candidates[$i]; + + LOG ($verbose_load, "picked image " .($i+1) . "/" . ($#candidates+1) . + ": $img"); + + $search_url = $img; # hmm... + return ($search_url, $img); +} + + +############################################################################ +# +# Pick images by waiting for driftnet to populate a temp dir with files. +# Requires driftnet version 0.1.5 or later. +# (Driftnet is a program by Chris Lightfoot that sniffs your local ethernet +# for images being downloaded by others.) +# Driftnet/webcollage integration by jwz. +# +############################################################################ + +# driftnet +sub pick_from_driftnet { + my ( $timeout ) = @_; + + my $id = $driftnet_magic; + my $dir = $driftnet_dir; + my $start = time; + my $now; + + error ("\$driftnet_dir unset?") unless ($dir); + $dir =~ s@/+$@@; + + error ("$dir unreadable") unless (-d "$dir/."); + + $timeout = $http_timeout unless ($timeout); + $last_search = $id; + + while ($now = time, $now < $start + $timeout) { + local *DIR; + opendir (DIR, $dir) || error ("$dir: $!"); + while (my $file = readdir(DIR)) { + next if ($file =~ m/^\./); + $file = "$dir/$file"; + closedir DIR; + LOG ($verbose_load, "picked file $file ($id)"); + return ($id, $file); + } + closedir DIR; + } + LOG (($verbose_net || $verbose_load), "timed out for $id"); + return (); +} + + +sub get_driftnet_file { + my ($file) = @_; + + error ("\$driftnet_dir unset?") unless ($driftnet_dir); + + my $id = $driftnet_magic; + my $re = qr/$driftnet_dir/; + error ("$id: $file not in $driftnet_dir?") + unless ($file =~ m@^$re@o); + + local *IN; + open (IN, $file) || error ("$id: $file: $!"); + my $body = ''; + while () { $body .= $_; } + close IN || error ("$id: $file: $!"); + unlink ($file) || error ("$id: $file: rm: $!"); + return ($id, $body); +} + + +sub spawn_driftnet { + my ($cmd) = @_; + + # make a directory to use. + while (1) { + my $tmp = $ENV{TEMPDIR} || "/tmp"; + $driftnet_dir = sprintf ("$tmp/driftcollage-%08x", rand(0xffffffff)); + LOG ($verbose_exec, "mkdir $driftnet_dir"); + last if mkdir ($driftnet_dir, 0700); + } + + if (! ($cmd =~ m/\s/)) { + # if the command didn't have any arguments in it, then it must be just + # a pointer to the executable. Append the default args to it. + my $dargs = $default_driftnet_cmd; + $dargs =~ s/^[^\s]+//; + $cmd .= $dargs; + } + + # point the driftnet command at our newly-minted private directory. + # + $cmd .= " -d $driftnet_dir"; + $cmd .= ">/dev/null" unless ($verbose_exec); + + my $pid = fork(); + if ($pid < 0) { error ("fork: $!\n"); } + if ($pid) { + # parent fork + push @pids_to_kill, $pid; + LOG ($verbose_exec, "forked for \"$cmd\""); + } else { + # child fork + nontrapping_system ($cmd) || error ("exec: $!"); + } + + # wait a bit, then make sure the process actually started up. + # + sleep (1); + error ("pid $pid failed to start \"$cmd\"") + unless (1 == kill (0, $pid)); +} ############################################################################ @@ -1138,9 +1705,8 @@ sub pick_from_yahoo_news_text { # Picks a random image on a random page, and returns two URLs: -# the page containing the image, and the image. +# the page containing the image, and the image. # Returns () if nothing found this time. -# Uses the url-randomizer 1 time in 5, else the image randomizer. # sub pick_image { @@ -1191,8 +1757,8 @@ sub blurb { } sub error { - ($_) = @_; - print STDERR blurb() . "$_\n"; + my ($err) = @_; + print STDERR blurb() . "$err\n"; exit 1; } @@ -1364,6 +1930,12 @@ sub save_recent_url { $_ = $url; my ($site) = m@^http://([^ \t\n\r/:]+)@; + return unless defined ($site); + + if ($base eq $driftnet_magic) { + $site = $driftnet_magic; + @recent_images = (); + } my $done = 0; foreach (@recent_images) { @@ -1448,10 +2020,12 @@ sub jpeg_size { while (ord($ch) != 0xDA && $i < $L) { # Find next marker, beginning with 0xFF. while (ord($ch) != 0xFF) { + return () if (length($body) <= $i); $ch = substr($body, $i, 1); $i++; } # markers can be padded with any number of 0xFF. while (ord($ch) == 0xFF) { + return () if (length($body) <= $i); $ch = substr($body, $i, 1); $i++; } @@ -1463,6 +2037,7 @@ sub jpeg_size { ($marker != 0xC4) && ($marker != 0xCC)) { # it's a SOFn marker $i += 3; + return () if (length($body) <= $i); my $s = substr($body, $i, 4); $i += 4; my ($a,$b,$c,$d) = unpack("C"x4, $s); return (($c<<8|$d), ($a<<8|$b)); @@ -1470,8 +2045,9 @@ sub jpeg_size { } else { # We must skip variables, since FFs in variable names aren't # valid JPEG markers. + return () if (length($body) <= $i); my $s = substr($body, $i, 2); $i += 2; - my ($c1, $c2) = unpack ("C"x2, $s); + my ($c1, $c2) = unpack ("C"x2, $s); my $length = ($c1 << 8) | $c2; return () if ($length < 2); $i += $length-2; @@ -1480,14 +2056,29 @@ sub jpeg_size { return (); } -# Given the raw body of a GIF or JPEG document, returns the dimensions of -# the image. +# Given the raw body of a PNG document, returns the dimensions of the image. +# +sub png_size { + my ($body) = @_; + return () unless ($body =~ m/^\211PNG\r/); + my ($bits) = ($body =~ m/^.{12}(.{12})/s); + return () unless defined ($bits); + return () unless ($bits =~ /^IHDR/); + my ($ign, $w, $h) = unpack("a4N2", $bits); + return ($w, $h); +} + + +# Given the raw body of a GIF, JPEG, or PNG document, returns the dimensions +# of the image. # sub image_size { my ($body) = @_; my ($w, $h) = gif_size ($body); if ($w && $h) { return ($w, $h); } - return jpeg_size ($body); + ($w, $h) = jpeg_size ($body); + if ($w && $h) { return ($w, $h); } + return png_size ($body); } @@ -1513,6 +2104,26 @@ sub bellrand { } +sub exit_cleanup { + x_cleanup(); + if (@pids_to_kill) { + print STDERR blurb() . "killing: " . join(' ', @pids_to_kill) . "\n"; + kill ('TERM', @pids_to_kill); + } +} + +sub signal_cleanup { + my ($sig) = @_; + print STDERR blurb() . (defined($sig) + ? "caught signal $sig." + : "exiting.") + . "\n" + if ($verbose_exec); + exit 1; +} + + + ############################################################################## # # Generating a list of urls only @@ -1536,25 +2147,34 @@ sub url_only_output { # ############################################################################## -my $image_ppm = ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp") . "/webcollage." . $$; -my $image_tmp1 = $image_ppm . "-1"; -my $image_tmp2 = $image_ppm . "-2"; +my $image_ppm = sprintf ("%s/webcollage-%08x", + ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"), + rand(0xFFFFFFFF)); +my $image_tmp1 = sprintf ("%s/webcollage-1-%08x", + ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"), + rand(0xFFFFFFFF)); +my $image_tmp2 = sprintf ("%s/webcollage-2-%08x", + ($ENV{TMPDIR} ? $ENV{TMPDIR} : "/tmp"), + rand(0xFFFFFFFF)); my $filter_cmd = undef; my $post_filter_cmd = undef; my $background = undef; +my @imagemap_areas = (); +my $imagemap_html_tmp = undef; +my $imagemap_jpg_tmp = undef; + + my $img_width; # size of the image being generated. my $img_height; -my $delay = 0; - +my $delay = 2; sub x_cleanup { - my ($sig) = @_; - print STDERR blurb() . "caught signal $sig.\n" if ($verbose_exec); unlink $image_ppm, $image_tmp1, $image_tmp2; - exit 1; + unlink $imagemap_html_tmp, $imagemap_jpg_tmp + if (defined ($imagemap_html_tmp)); } @@ -1563,7 +2183,7 @@ sub x_cleanup { # sub nontrapping_system { $! = 0; - + $_ = join(" ", @_); s/\"[^\"]+\"/\"...\"/g; @@ -1590,9 +2210,9 @@ sub nontrapping_system { } -# Given the URL of a GIF or JPEG image, and the body of that image, writes a -# PPM to the given output file. Returns the width/height of the image if -# successful. +# Given the URL of a GIF, JPEG, or PNG image, and the body of that image, +# writes a PPM to the given output file. Returns the width/height of the +# image if successful. # sub image_to_pnm { my ($url, $body, $output) = @_; @@ -1604,9 +2224,12 @@ sub image_to_pnm { } elsif ((@_ = jpeg_size ($body))) { ($w, $h) = @_; $cmd = "djpeg"; + } elsif ((@_ = png_size ($body))) { + ($w, $h) = @_; + $cmd = "pngtopnm"; } else { LOG (($verbose_pbm || $verbose_load), - "not a GIF or JPG" . + "not a GIF, JPG, or PNG" . (($body =~ m@<(base|html|head|body|script|table|a href)>@i) ? " (looks like HTML)" : "") . ": $url"); @@ -1704,10 +2327,31 @@ my $ppm_to_root_window_cmd = undef; sub x_or_pbm_output { + my ($window_id) = @_; + + # Check for our helper program, to see whether we need to use PPM pipelines. + # + $_ = "webcollage-helper"; + if (defined ($webcollage_helper) || which ($_)) { + $webcollage_helper = $_ unless (defined($webcollage_helper)); + LOG ($verbose_pbm, "found \"$webcollage_helper\""); + $webcollage_helper .= " -v"; + } else { + LOG (($verbose_pbm || $verbose_load), "no $_ program"); + } # make sure the various programs we execute exist, right up front. # - foreach ("ppmmake", "giftopnm", "djpeg", "pnmpaste", "pnmscale", "pnmcut") { + my @progs = ("ppmmake"); # always need this one + + if (!defined($webcollage_helper)) { + # Only need these others if we don't have the helper. + @progs = (@progs, + "giftopnm", "pngtopnm", "djpeg", + "pnmpaste", "pnmscale", "pnmcut"); + } + + foreach (@progs) { which ($_) || error "$_ not found on \$PATH."; } @@ -1715,24 +2359,41 @@ sub x_or_pbm_output { # $ppm_to_root_window_cmd = pick_root_displayer(); + if (defined ($window_id)) { + error ("-window-id only works if xscreensaver-getimage is installed") + unless ($ppm_to_root_window_cmd =~ m/^xscreensaver-getimage\b/); - $SIG{HUP} = \&x_cleanup; - $SIG{INT} = \&x_cleanup; - $SIG{QUIT} = \&x_cleanup; - $SIG{ABRT} = \&x_cleanup; - $SIG{KILL} = \&x_cleanup; - $SIG{TERM} = \&x_cleanup; - - # Need this so that if giftopnm dies, we don't die. - $SIG{PIPE} = 'IGNORE'; + error ("unparsable window id: $window_id") + unless ($window_id =~ m/^\d+$|^0x[\da-f]+$/i); + $ppm_to_root_window_cmd =~ s/--?root\b/$window_id/ || + error ("unable to munge displayer: $ppm_to_root_window_cmd"); + } if (!$img_width || !$img_height) { - $_ = "xdpyinfo"; - which ($_) || error "$_ not found on \$PATH."; - $_ = `$_`; - ($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /; - if (!defined($img_height)) { - error "xdpyinfo failed."; + + if (!defined ($window_id) && + defined ($ENV{XSCREENSAVER_WINDOW})) { + $window_id = $ENV{XSCREENSAVER_WINDOW}; + } + + if (!defined ($window_id)) { + $_ = "xdpyinfo"; + which ($_) || error "$_ not found on \$PATH."; + $_ = `$_`; + ($img_width, $img_height) = m/dimensions: *(\d+)x(\d+) /; + if (!defined($img_height)) { + error "xdpyinfo failed."; + } + } else { # we have a window id + $_ = "xwininfo"; + which ($_) || error "$_ not found on \$PATH."; + $_ .= " -id $window_id"; + $_ = `$_`; + ($img_width, $img_height) = m/^\s*Width:\s*(\d+)\n\s*Height:\s*(\d+)\n/m; + + if (!defined($img_height)) { + error "xwininfo failed."; + } } } @@ -1781,13 +2442,17 @@ sub x_or_pbm_output { ($iw, $ih) = @_; $cmd = "djpeg |"; + } elsif ((@_ = png_size ($body))) { + ($iw, $ih) = @_; + $cmd = "pngtopnm |"; + } elsif ($body =~ m/^P\d\n(\d+) (\d+)\n/) { $iw = $1; $ih = $2; $cmd = ""; } else { - error "$bgimage is not a GIF, JPEG, or PPM."; + error "$bgimage is not a GIF, JPEG, PNG, or PPM."; } my $x = int (($img_width - $iw) / 2); @@ -1835,11 +2500,40 @@ sub paste_image { LOG ($verbose_pbm, "got $img (" . length($body) . ")"); - my ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1); - $body = undef; - if (!$iw || !$ih) { - LOG ($verbose_pbm, "unable to make PBM from $img"); - return 0; + my ($iw, $ih); + + # If we are using the webcollage-helper, then we do not need to convert this + # image to a PPM. But, if we're using a filter command, we still must, since + # that's what the filters expect (webcollage-helper can read PPMs, so that's + # fine.) + # + if (defined ($webcollage_helper) && + !defined ($filter_cmd)) { + + ($iw, $ih) = image_size ($body); + if (!$iw || !$ih) { + LOG (($verbose_pbm || $verbose_load), + "not a GIF, JPG, or PNG" . + (($body =~ m@<(base|html|head|body|script|table|a href)>@i) + ? " (looks like HTML)" : "") . + ": $img"); + $suppress_audit = 1; + $body = undef; + return 0; + } + + local *OUT; + open (OUT, ">$image_tmp1") || error ("writing $image_tmp1: $!"); + print OUT $body || error ("writing $image_tmp1: $!"); + close OUT || error ("writing $image_tmp1: $!"); + + } else { + ($iw, $ih) = image_to_pnm ($img, $body, $image_tmp1); + $body = undef; + if (!$iw || !$ih) { + LOG ($verbose_pbm, "unable to make PBM from $img"); + return 0; + } } record_success ($load_method, $img, $base); @@ -1872,18 +2566,20 @@ sub paste_image { return 0 unless ($iw && $ih); } - my $target_w = $img_width; + my $target_w = $img_width; # max rectangle into which the image must fit my $target_h = $img_height; my $cmd = ""; + my $scale = 1.0; # Usually scale the image to fit on the screen -- but sometimes scale it - # to fit on half or a quarter of the screen. Note that we don't merely - # scale it to fit, we instead cut it in half until it fits -- that should - # give a wider distribution of sizes. + # to fit on half or a quarter of the screen. (We do this by reducing the + # size of the target rectangle.) Note that the image is not merely scaled + # to fit; we instead cut the image in half repeatedly until it fits in the + # target rectangle -- that gives a wider distribution of sizes. # - if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; } + if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; } # reduce target rect if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; } if ($iw > $target_w || $ih > $target_h) { @@ -1891,13 +2587,14 @@ sub paste_image { $ih > $target_h) { $iw = int($iw / 2); $ih = int($ih / 2); + $scale /= 2; } if ($iw <= 10 || $ih <= 10) { LOG ($verbose_pbm, "scaling to ${iw}x$ih would have been bogus."); return 0; } - LOG ($verbose_pbm, "scaling to ${iw}x$ih"); + LOG ($verbose_pbm, "scaling to ${iw}x$ih ($scale)"); $cmd .= " | pnmscale -xsize $iw -ysize $ih"; } @@ -1932,10 +2629,10 @@ sub paste_image { } if (rand() < $crop_chance) { - + my $ow = $crop_w; my $oh = $crop_h; - + if ($crop_w > $min_width) { # if it's a banner, select the width linearly. # otherwise, select a bell. @@ -1950,7 +2647,7 @@ sub paste_image { $crop_h = $min_height + int (bellrand() * ($crop_h - $min_height)); $crop_y = int (rand() * ($oh - $crop_h)); } - + if ($crop_x != 0 || $crop_y != 0 || $crop_w != $iw || $crop_h != $ih) { LOG ($verbose_pbm, @@ -1970,13 +2667,13 @@ sub paste_image { $y < 0 || $x + $crop_w > $img_width || $y + $crop_h > $img_height) { - + LOG ($verbose_pbm, "cropping for effective paste of ${crop_w}x$crop_h \@ $x,$y"); - + if ($x < 0) { $crop_x -= $x; $crop_w += $x; $x = 0; } if ($y < 0) { $crop_y -= $y; $crop_h += $y; $y = 0; } - + if ($x + $crop_w >= $img_width) { $crop_w = $img_width - $x - 1; } if ($y + $crop_h >= $img_height) { $crop_h = $img_height - $y - 1; } } @@ -1984,7 +2681,7 @@ sub paste_image { # If any cropping needs to happen, add pnmcut. # if ($crop_x != 0 || $crop_y != 0 || - $crop_w != $iw || $crop_h != $ih) { + $crop_w != $iw || $crop_h != $ih) { $iw = $crop_w; $ih = $crop_h; $cmd .= " | pnmcut $crop_x $crop_y $iw $ih"; @@ -1997,23 +2694,46 @@ sub paste_image { $cmd =~ s@^ *\| *@@; - $_ = "($cmd)"; - $_ .= " < $image_tmp1 > $image_tmp2"; + if (defined ($webcollage_helper)) { + $cmd = "$webcollage_helper $image_tmp1 $image_ppm " . + "$scale $opacity " . + "$crop_x $crop_y $x $y " . + "$iw $ih"; + $_ = $cmd; + + } else { + # use a PPM pipeline + $_ = "($cmd)"; + $_ .= " < $image_tmp1 > $image_tmp2"; + } if ($verbose_pbm) { $_ = "($_) 2>&1 | sed s'/^/" . blurb() . "/'"; } else { $_ .= " 2> /dev/null"; } + my $rc = nontrapping_system ($_); + if (defined ($webcollage_helper) && -z $image_ppm) { + LOG (1, "failed command: \"$cmd\""); + print STDERR "\naudit log:\n\n\n"; + print STDERR ("#" x 78) . "\n"; + print STDERR blurb() . "$image_ppm has zero size\n"; + showlog(); + print STDERR "\n\n"; + exit (1); + } + if ($rc != 0) { LOG (($verbose_pbm || $verbose_load), "failed command: \"$cmd\""); LOG (($verbose_pbm || $verbose_load), "failed URL: \"$img\" (${ow}x$oh)"); return; } - rename ($image_tmp2, $image_ppm) || return; + if (!defined ($webcollage_helper)) { + rename ($image_tmp2, $image_ppm) || return; + } my $target = "$image_ppm"; @@ -2022,8 +2742,20 @@ sub paste_image { # cumulative. # if ($post_filter_cmd) { + + my $cmd; + $target = $image_tmp1; - $rc = nontrapping_system "($post_filter_cmd) < $image_ppm > $target"; + if (!defined ($webcollage_helper)) { + $cmd = "($post_filter_cmd) < $image_ppm > $target"; + } else { + # Blah, my scripts need the JPEG data, but some other folks need + # the PPM data -- what to do? Ignore the problem, that's what! +# $cmd = "djpeg < $image_ppm | ($post_filter_cmd) > $target"; + $cmd = "($post_filter_cmd) < $image_ppm > $target"; + } + + $rc = nontrapping_system ($cmd); if ($rc != 0) { LOG ($verbose_pbm, "filter failed: \"$post_filter_cmd\"\n"); return; @@ -2034,7 +2766,7 @@ sub paste_image { my $tsize = (stat($target))[7]; if ($tsize > 200) { $cmd = "$ppm_to_root_window_cmd $target"; - + # xv seems to hate being killed. it tends to forget to clean # up after itself, and leaves windows around and colors allocated. # I had this same problem with vidwhacker, and I'm not entirely @@ -2046,14 +2778,14 @@ sub paste_image { # to do anyway. # $cmd .= " &"; - + $rc = nontrapping_system ($cmd); - + if ($rc != 0) { LOG (($verbose_pbm || $verbose_load), "display failed: \"$cmd\""); return; } - + } else { LOG ($verbose_pbm, "$target size is $tsize"); } @@ -2063,22 +2795,151 @@ sub paste_image { print STDOUT "image: ${iw}x${ih} @ $x,$y $base $source\n" if ($verbose_imgmap); + if ($imagemap_base) { + update_imagemap ($base, $x, $y, $iw, $ih, + $image_ppm, $img_width, $img_height); + } + clearlog(); return 1; } +sub update_imagemap { + my ($url, $x, $y, $w, $h, $image_ppm, $image_width, $image_height) = @_; + + $current_state = "imagemap"; + + my $max_areas = 200; + + $url = html_quote ($url); + my $x2 = $x + $w; + my $y2 = $y + $h; + my $area = ""; + unshift @imagemap_areas, $area; # put one on the front + if ($#imagemap_areas >= $max_areas) { + pop @imagemap_areas; # take one off the back. + } + + LOG ($verbose_pbm, "area: $x,$y,$x2,$y2 (${w}x$h)"); + + my $map_name = $imagemap_base; + $map_name =~ s@^.*/@@; + $map_name = 'collage' if ($map_name eq ''); + + my $imagemap_html = $imagemap_base . ".html"; + my $imagemap_jpg = $imagemap_base . ".jpg"; + + if (!defined ($imagemap_html_tmp)) { + $imagemap_html_tmp = $imagemap_html . sprintf (".%08x", rand(0xffffffff)); + $imagemap_jpg_tmp = $imagemap_jpg . sprintf (".%08x", rand(0xffffffff)); + } + + # Read the imagemap html file (if any) to get a template. + # + my $template_html = ''; + { + local *IN; + if (open (IN, "<$imagemap_html")) { + while () { $template_html .= $_; } + close IN; + LOG ($verbose_pbm, "read template $imagemap_html"); + } + + if ($template_html =~ m/^\s*$/s) { + $template_html = ("\n" . + "\n"); + LOG ($verbose_pbm, "created dummy template"); + } + } + + # Write the jpg to a tmp file + # + { + my $cmd; + if (defined ($webcollage_helper)) { + $cmd = "cp -p $image_ppm $imagemap_jpg_tmp"; + } else { + $cmd = "cjpeg < $image_ppm > $imagemap_jpg_tmp"; + } + my $rc = nontrapping_system ($cmd); + if ($rc != 0) { + error ("imagemap jpeg failed: \"$cmd\"\n"); + } + } + + # Write the html to a tmp file + # + { + my $body = $template_html; + my $areas = join ("\n\t", @imagemap_areas); + my $map = ("\n\t$areas\n"); + my $img = (""); + $body =~ s@().*?()@$map@is; + $body =~ s@]*\bUSEMAP\b[^<>]*>@$img@is; + + # if there are magic webcollage spans in the html, update those too. + # + { + my @st = stat ($imagemap_jpg_tmp); + my $date = strftime("%d-%b-%Y %l:%M:%S %p %Z", localtime($st[9])); + my $size = int(($st[7] / 1024) + 0.5) . "K"; + $body =~ s@().*?()@$1$date$2@si; + $body =~ s@().*?()@$1$size$2@si; + } + + local *OUT; + open (OUT, ">$imagemap_html_tmp") || error ("$imagemap_html_tmp: $!"); + print OUT $body || error ("$imagemap_html_tmp: $!"); + close OUT || error ("$imagemap_html_tmp: $!"); + LOG ($verbose_pbm, "wrote $imagemap_html_tmp"); + } + + # Rename the two tmp files to the real files + # + rename ($imagemap_html_tmp, $imagemap_html) || + error "renaming $imagemap_html_tmp to $imagemap_html"; + LOG ($verbose_pbm, "wrote $imagemap_html"); + rename ($imagemap_jpg_tmp, $imagemap_jpg) || + error "renaming $imagemap_jpg_tmp to $imagemap_jpg"; + LOG ($verbose_pbm, "wrote $imagemap_jpg"); +} + + +sub init_signals { + + $SIG{HUP} = \&signal_cleanup; + $SIG{INT} = \&signal_cleanup; + $SIG{QUIT} = \&signal_cleanup; + $SIG{ABRT} = \&signal_cleanup; + $SIG{KILL} = \&signal_cleanup; + $SIG{TERM} = \&signal_cleanup; + + # Need this so that if giftopnm dies, we don't die. + $SIG{PIPE} = 'IGNORE'; +} + +END { exit_cleanup(); } + + sub main { $| = 1; srand(time ^ $$); my $verbose = 0; + my $dict; + my $driftnet_cmd = 0; $current_state = "init"; $load_method = "none"; my $root_p = 0; + my $window_id = undef; # historical suckage: the environment variable name is lower case. $http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY}; @@ -2094,11 +2955,17 @@ sub main { $ENV{DISPLAY} = shift @ARGV; } elsif ($_ eq "-root") { $root_p = 1; + } elsif ($_ eq "-window-id" || $_ eq "--window-id") { + $window_id = shift @ARGV; + $root_p = 1; } elsif ($_ eq "-no-output") { $no_output_p = 1; } elsif ($_ eq "-urls-only") { $urls_only_p = 1; $no_output_p = 1; + } elsif ($_ eq "-imagemap") { + $imagemap_base = shift @ARGV; + $no_output_p = 1; } elsif ($_ eq "-verbose") { $verbose++; } elsif (m/^-v+$/) { @@ -2123,11 +2990,42 @@ sub main { } } elsif ($_ eq "-proxy" || $_ eq "-http-proxy") { $http_proxy = shift @ARGV; + } elsif ($_ eq "-dictionary" || $_ eq "-dict") { + $dict = shift @ARGV; + } elsif ($_ eq "-driftnet" || $_ eq "--driftnet") { + @search_methods = ( 100, "driftnet", \&pick_from_driftnet ); + if (! ($ARGV[0] =~ m/^-/)) { + $driftnet_cmd = shift @ARGV; + } else { + $driftnet_cmd = $default_driftnet_cmd; + } + } elsif ($_ eq "-debug" || $_ eq "--debug") { + my $which = shift @ARGV; + my @rest = @search_methods; + my $ok = 0; + while (@rest) { + my $pct = shift @rest; + my $name = shift @rest; + my $tfn = shift @rest; + + if ($name eq $which) { + @search_methods = (100, $name, $tfn); + $ok = 1; + last; + } + } + error "no such search method as \"$which\"" unless ($ok); + LOG (1, "DEBUG: using only \"$which\""); + } else { - print STDERR "$copyright\nusage: $progname [-root]" . - " [-display dpy] [-root] [-verbose] [-timeout secs]\n" . - "\t\t [-delay secs] [-filter cmd] [-filter2 cmd]\n" . - "\t\t [-http-proxy host[:port]]\n"; + print STDERR "$copyright\nusage: $progname " . + "[-root] [-display dpy] [-verbose] [-debug which]\n" . + "\t\t [-timeout secs] [-delay secs] [-size WxH]\n" . + "\t\t [-no-output] [-urls-only] [-imagemap filename]\n" . + "\t\t [-filter cmd] [-filter2 cmd] [-background color]\n" . + "\t\t [-dictionary dictionary-file] [-http-proxy host[:port]]\n" . + "\t\t [-driftnet [driftnet-program-and-args]]\n" . + "\n"; exit 1; } } @@ -2200,11 +3098,21 @@ sub main { $verbose_exec = 1; } + if ($dict) { + error ("$dict does not exist") unless (-f $dict); + $wordlist = $dict; + } else { + pick_dictionary(); + } + + init_signals(); + + spawn_driftnet ($driftnet_cmd) if ($driftnet_cmd); if ($urls_only_p) { - url_only_output; + url_only_output (); } else { - x_or_pbm_output; + x_or_pbm_output ($window_id); } }