#!/usr/bin/perl -w
#
-# webcollage, Copyright (c) 1999-2001 by Jamie Zawinski <jwz@jwz.org>
+# webcollage, Copyright (c) 1999-2003 by Jamie Zawinski <jwz@jwz.org>
# This program decorates the screen with random images from the web.
# One satisfied customer described it as "a nonstop pop culture brainbath."
#
# 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\
+# 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:
+#
+# default-n: webcollage -root -driftnet \n\
+#
+# Driftnet is the Unix implementation of the MacOS "EtherPEG" program.
+
+
require 5;
use strict;
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.104 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
+my $copyright = "WebCollage $version, Copyright (c) 1999-2002" .
" Jamie Zawinski <jwz\@jwz.org>\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,
+my @search_methods = ( 77, "altavista", \&pick_from_alta_vista_random_link,
+ 14, "yahoorand", \&pick_from_yahoo_random_link,
+ 9, "yahoonews", \&pick_from_yahoo_news_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,
- );
+ # 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,
-#@search_methods=(100, "lycos", \&pick_from_lycos_text);
+ # 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,
+ );
# 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 = (
+ "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",
"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',
);
+# 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
#
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.
);
"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...
);
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 $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",
my $cookie = $cookies{$them};
+ my $user_agent = "$progname/$version";
+
+ if ($url =~ m@^http://www\.altavista\.com/@ ||
+ $url =~ m@^http://random\.yahoo\.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";
LOG ($verbose_http, " ==> $_");
}
print S $hdrs;
- my $http = <S>;
+ my $http = <S> || "";
+
+ # 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;
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;
if ( $http =~ m@^HTTP/[0-9.]+ 30[123]@ ) {
$_ = $head;
+
my ( $location ) = m@^location:[ \t]*(.*)$@im;
if ( $location ) {
$location =~ s/[\r\n]$//;
} 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;
} elsif ( ! m@^[^/:?]+:@ ) {
$_ = "$base$link";
s@/\./@/@g;
- while (s@/\.\./@/@g) {
- }
+ 1 while (s@/[^/]+/\.\./@/@g);
}
# skip non-http
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}) {
}
LOG ($verbose_filter,
- " image $url" .
+ " image $url" .
($width && $height ? " (${width}x${height})" : "") .
($was_inline ? " (inline)" : ""));
$_ = 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];
############################################################################
+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];
}
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;
+}
+
+
# Loads the given URL (a search on some search engine) and returns:
# - the total number of hits the search engine claimed it had;
# - a list of URLs from the page that the search engine returned;
$search_count = $1;
} elsif ($body =~ m@found about ((\d{1,3})(,\d{3})*|\d+) results@) {
$search_count = $1;
- } elsif ($body =~ m@\b\d+ - \d+ of (\d+)\b@i) { # imagevista
+ } elsif ($body =~ m@\b\d+ - \d+ of (\d+)\b@i) { # avimages
+ $search_count = $1;
+ } elsif ($body =~ m@About ((\d{1,3})(,\d{3})*) images@i) { # avimages
+ $search_count = $1;
+ } elsif ($body =~ m@We found ((\d{1,3})(,\d{3})*|\d+) results@i) { # *vista
$search_count = $1;
- } elsif ($body =~ m@About ((\d{1,3})(,\d{3})*) images@i) { # imagevista
+ } elsif ($body =~ m@ of about <B>((\d{1,3})(,\d{3})*)<@i) { # googleimages
$search_count = $1;
+ } elsif ($body =~ m@<B>((\d{1,3})(,\d{3})*)</B> 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/);
############################################################################
# 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;
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 ();
+ }
+}
+
+\f
+############################################################################
+#
+# 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;
############################################################################
-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_words(0);
my $page = (int(rand(9)) + 1);
my $search_url = $alta_vista_images_url . $words;
my @candidates = ();
foreach my $u (@subpages) {
+
+ # avtext is encoding their URLs now.
+ next unless ($u =~ m@^/r.*\&r=([^&]+).*@);
+ $u = url_unquote($1);
+
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@[/.]doubleclick\.net\b@i); # you cretins
}
+\f
+############################################################################
+#
+# Pick images by feeding random words into Google Image Search.
+# By Charles Gales <gales@us.ibm.com>
+#
+############################################################################
+
+
+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);
+}
+
+
+\f
+############################################################################
+#
+# Pick images by feeding random *numbers* into Google Image Search.
+# By jwz, suggested by from 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 = "http://$1";
+
+ 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);
+}
+
+
\f
############################################################################
#
############################################################################
-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;
# 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 =~ m@^/r.*\&r=([^&]+).*@);
+ $u = url_unquote($1);
LOG ($verbose_filter, " candidate: $u");
push @candidates, $u;
#
############################################################################
-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;
+ # 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);
foreach my $u (@subpages) {
# Hotbot plays redirection games too
- next unless ($u =~ m@^/director.asp\?target=([^&]+)@);
+ next unless ($u =~ m@/director.asp\?.*\btarget=([^&]+)@);
$u = url_decode($1);
LOG ($verbose_filter, " candidate: $u");
#
############################################################################
-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;
+ # 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);
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=([^&]+)@);
+ # Lycos plays redirection games.
+ next unless ($u =~ m@^http://click.lycos.com/director.asp
+ .*
+ \btarget=([^&]+)
+ .*
+ @x);
$u = url_decode($1);
LOG ($verbose_filter, " candidate: $u");
#
############################################################################
-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;
+ my $words = random_words(0);
my $search_url = $yahoo_news_url . $words;
my ($search_hit_count, @subpages) =
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;
+\f
+############################################################################
+#
+# 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 (<IN>) { $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));
+}
+
\f
############################################################################
#
# 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 {
}
sub error {
- ($_) = @_;
- print STDERR blurb() . "$_\n";
+ my ($err) = @_;
+ print STDERR blurb() . "$err\n";
exit 1;
}
$_ = $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) {
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++;
}
($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));
} 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;
}
+sub signal_cleanup {
+ my ($sig) = @_;
+ print STDERR blurb() . (defined($sig)
+ ? "caught signal $sig."
+ : "exiting.")
+ . "\n"
+ if ($verbose_exec);
+
+ x_cleanup();
+
+ if (@pids_to_kill) {
+ print STDERR blurb() . "killing: " . join(' ', @pids_to_kill) . "\n";
+ kill ('TERM', @pids_to_kill);
+ }
+
+ exit 1;
+}
+
##############################################################################
#
# Generating a list of urls only
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;
}
#
sub nontrapping_system {
$! = 0;
-
+
$_ = join(" ", @_);
s/\"[^\"]+\"/\"...\"/g;
# 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
+# PPM to the given output file. Returns the width/height of the image if
# successful.
#
sub image_to_pnm {
sub x_or_pbm_output {
+ # 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", "djpeg", "pnmpaste", "pnmscale", "pnmcut");
+ }
+
+ foreach (@progs) {
which ($_) || error "$_ not found on \$PATH.";
}
#
$ppm_to_root_window_cmd = pick_root_displayer();
-
- $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';
-
if (!$img_width || !$img_height) {
$_ = "xdpyinfo";
which ($_) || error "$_ not found on \$PATH.";
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 or JPG" .
+ (($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);
my $target_h = $img_height;
my $cmd = "";
+ my $scale = 1.0;
# Usually scale the image to fit on the screen -- but sometimes scale it
# scale it to fit, we instead cut it in half until it fits -- that should
# give 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; }
+ if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
+ if (rand() < 0.3) { $target_w /= 2; $target_h /= 2; $scale /= 2; }
if ($iw > $target_w || $ih > $target_h) {
while ($iw > $target_w ||
}
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.
$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,
$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; }
}
$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";
# 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;
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
# 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");
}
}
+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 { signal_cleanup(); }
+
+
sub main {
$| = 1;
srand(time ^ $$);
my $verbose = 0;
+ my $dict;
+ my $driftnet_cmd = 0;
$current_state = "init";
$load_method = "none";
}
} 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] [-filter cmd] [-filter2 cmd]\n" .
+ "\t\t [-no-output] [-urls-only] [-background color] [-size WxH]\n" .
+ "\t\t [-dictionary dictionary-file] [-http-proxy host[:port]]\n" .
+ "\t\t [-driftnet [driftnet-program-and-args]]\n" .
+ "\n";
exit 1;
}
}
$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;
projects / xscreensaver / blobdiff