2
# Copyright � 2005 Jamie Zawinski <jwz@jwz.org>
4
# Permission to use, copy, modify, distribute, and sell this software and its
5
# documentation for any purpose is hereby granted without fee, provided that
6
# the above copyright notice appear in all copies and that both that
7
# copyright notice and this permission notice appear in supporting
8
# documentation. No representations are made about the suitability of this
9
# software for any purpose. It is provided "as is" without express or
12
# This program writes some text to stdout, based on preferences in the
13
# .xscreensaver file. It may load a file, a URL, run a program, or just
16
# Created: 19-Mar-2005.
22
use POSIX qw(strftime);
23
use Text::Wrap qw(wrap);
26
my $progname = $0; $progname =~ s@.*/@@g;
27
my $version = q{ $Revision: 1.3 $ }; $version =~ s/^[^0-9]+([0-9.]+).*$/$1/;
30
my $http_proxy = undef;
32
my $config_file = $ENV{HOME} . "/.xscreensaver";
33
my $text_mode = 'date';
34
my $text_literal = '';
36
my $text_program = '';
39
my $wrap_columns = undef;
42
# Maps HTML character entities to the corresponding Latin1 characters.
45
"quot" => '"', "amp" => '&', "lt" => '<', "gt" => '>',
46
"nbsp" => ' ', "iexcl" => '�', "cent" => '�', "pound" => '�',
47
"curren" => '�', "yen" => '�', "brvbar" => '�', "sect" => '�',
48
"uml" => '�', "copy" => '�', "ordf" => '�', "laquo" => '�',
49
"not" => '�', "shy" => '�', "reg" => '�', "macr" => '�',
50
"deg" => '�', "plusmn" => '�', "sup2" => '�', "sup3" => '�',
51
"acute" => '�', "micro" => '�', "para" => '�', "middot" => '�',
52
"cedil" => '�', "sup1" => '�', "ordm" => '�', "raquo" => '�',
53
"frac14" => '�', "frac12" => '�', "frac34" => '�', "iquest" => '�',
54
"Agrave" => '�', "Aacute" => '�', "Acirc" => '�', "Atilde" => '�',
55
"Auml" => '�', "Aring" => '�', "AElig" => '�', "Ccedil" => '�',
56
"Egrave" => '�', "Eacute" => '�', "Ecirc" => '�', "Euml" => '�',
57
"Igrave" => '�', "Iacute" => '�', "Icirc" => '�', "Iuml" => '�',
58
"ETH" => '�', "Ntilde" => '�', "Ograve" => '�', "Oacute" => '�',
59
"Ocirc" => '�', "Otilde" => '�', "Ouml" => '�', "times" => '�',
60
"Oslash" => '�', "Ugrave" => '�', "Uacute" => '�', "Ucirc" => '�',
61
"Uuml" => '�', "Yacute" => '�', "THORN" => '�', "szlig" => '�',
62
"agrave" => '�', "aacute" => '�', "acirc" => '�', "atilde" => '�',
63
"auml" => '�', "aring" => '�', "aelig" => '�', "ccedil" => '�',
64
"egrave" => '�', "eacute" => '�', "ecirc" => '�', "euml" => '�',
65
"igrave" => '�', "iacute" => '�', "icirc" => '�', "iuml" => '�',
66
"eth" => '�', "ntilde" => '�', "ograve" => '�', "oacute" => '�',
67
"ocirc" => '�', "otilde" => '�', "ouml" => '�', "divide" => '�',
68
"oslash" => '�', "ugrave" => '�', "uacute" => '�', "ucirc" => '�',
69
"uuml" => '�', "yacute" => '�', "thorn" => '�', "yuml" => '�',
73
# Maps certain UTF8 characters (2 or 3 bytes) to the corresponding
76
my %unicode_latin1_table = (
77
"\xC2\xA1" => '�', "\xC2\xA2" => '�', "\xC2\xA3" => '�', "\xC2\xA4" => '�',
78
"\xC2\xA5" => '�', "\xC2\xA6" => '�', "\xC2\xA7" => '�', "\xC2\xA8" => '�',
79
"\xC2\xA9" => '�', "\xC2\xAA" => '�', "\xC2\xAB" => '�', "\xC2\xAC" => '�',
80
"\xC2\xAD" => '�', "\xC2\xAE" => '�', "\xC2\xAF" => '�', "\xC2\xB0" => '�',
81
"\xC2\xB1" => '�', "\xC2\xB2" => '�', "\xC2\xB3" => '�', "\xC2\xB4" => '�',
82
"\xC2\xB5" => '�', "\xC2\xB6" => '�', "\xC2\xB7" => '�', "\xC2\xB8" => '�',
83
"\xC2\xB9" => '�', "\xC2\xBA" => '�', "\xC2\xBB" => '�', "\xC2\xBC" => '�',
84
"\xC2\xBD" => '�', "\xC2\xBE" => '�', "\xC2\xBF" => '�', "\xC3\x80" => '�',
85
"\xC3\x81" => '�', "\xC3\x82" => '�', "\xC3\x83" => '�', "\xC3\x84" => '�',
86
"\xC3\x85" => '�', "\xC3\x86" => '�', "\xC3\x87" => '�', "\xC3\x88" => '�',
87
"\xC3\x89" => '�', "\xC3\x8A" => '�', "\xC3\x8B" => '�', "\xC3\x8C" => '�',
88
"\xC3\x8D" => '�', "\xC3\x8E" => '�', "\xC3\x8F" => '�', "\xC3\x90" => '�',
89
"\xC3\x91" => '�', "\xC3\x92" => '�', "\xC3\x93" => '�', "\xC3\x94" => '�',
90
"\xC3\x95" => '�', "\xC3\x96" => '�', "\xC3\x97" => '�', "\xC3\x98" => '�',
91
"\xC3\x99" => '�', "\xC3\x9A" => '�', "\xC3\x9B" => '�', "\xC3\x9C" => '�',
92
"\xC3\x9D" => '�', "\xC3\x9E" => '�', "\xC3\x9F" => '�', "\xC3\xA0" => '�',
93
"\xC3\xA1" => '�', "\xC3\xA2" => '�', "\xC3\xA3" => '�', "\xC3\xA4" => '�',
94
"\xC3\xA5" => '�', "\xC3\xA6" => '�', "\xC3\xA7" => '�', "\xC3\xA8" => '�',
95
"\xC3\xA9" => '�', "\xC3\xAA" => '�', "\xC3\xAB" => '�', "\xC3\xAC" => '�',
96
"\xC3\xAD" => '�', "\xC3\xAE" => '�', "\xC3\xAF" => '�', "\xC3\xB0" => '�',
97
"\xC3\xB1" => '�', "\xC3\xB2" => '�', "\xC3\xB3" => '�', "\xC3\xB4" => '�',
98
"\xC3\xB5" => '�', "\xC3\xB6" => '�', "\xC3\xB7" => '�', "\xC3\xB8" => '�',
99
"\xC3\xB9" => '�', "\xC3\xBA" => '�', "\xC3\xBB" => '�', "\xC3\xBC" => '�',
100
"\xC3\xBD" => '�', "\xC3\xBE" => '�', "\xC3\xBF" => '�',
102
"\xE2\x80\x93" => '--', "\xE2\x80\x94" => '--',
103
"\xE2\x80\x98" => '`', "\xE2\x80\x99" => '\'',
104
"\xE2\x80\x9C" => "``", "\xE2\x80\x9D" => "''",
105
"\xE2\x80\xA6" => '...',
109
# Convert any HTML entities to Latin1 characters.
113
$text =~ s/(&(\#)?([[:alpha:]\d]+);?)/
117
$c = chr($3); # the &#number is always decimal, right?
119
$c = $entity_table{$3};
121
# print STDERR "$progname: warning: unknown HTML character entity \"$1\"\n"
130
# Convert any Unicode characters to Latin1 if possible.
131
# Unconvertable bytes are left alone.
135
foreach my $key (keys (%unicode_latin1_table)) {
136
my $val = $unicode_latin1_table{$key};
137
$text =~ s/$key/$val/gs;
143
# Reads the prefs we use from ~/.xscreensaver
150
if (open (IN, "<$config_file")) {
151
print STDERR "$progname: reading $config_file\n" if ($verbose > 1);
153
while (<IN>) { $body .= $_; }
155
$got_any_p = get_prefs_1 ($body);
157
} elsif ($verbose > 1) {
158
print STDERR "$progname: $config_file: $!\n";
162
# We weren't able to read settings from the .xscreensaver file.
163
# Fall back to any settings in the X resource database
164
# (/usr/X11R6/lib/X11/app-defaults/XScreenSaver)
166
print STDERR "$progname: reading X resources\n" if ($verbose > 1);
167
my $body = `appres XScreenSaver xscreensaver -1`;
168
$got_any_p = get_prefs_1 ($body);
172
printf STDERR "$progname: mode: $text_mode\n";
173
printf STDERR "$progname: literal: $text_literal\n";
174
printf STDERR "$progname: file: $text_file\n";
175
printf STDERR "$progname: program: $text_program\n";
176
printf STDERR "$progname: url: $text_url\n";
179
$text_mode =~ tr/A-Z/a-z/;
180
$text_literal =~ s@\\n@\n@gs;
190
if ($body =~ m/^[.*]*textMode:[ \t]*([^\s]+)\s*$/im) {
194
if ($body =~ m/^[.*]*textLiteral:[ \t]*(.*?)[ \t]*$/im) {
197
if ($body =~ m/^[.*]*textFile:[ \t]*(.*?)[ \t]*$/im) {
200
if ($body =~ m/^[.*]*textProgram:[ \t]*(.*?)[ \t]*$/im) {
203
if ($body =~ m/^[.*]*textURL:[ \t]*(.*?)[ \t]*$/im) {
211
# like system() but checks errors.
216
print STDERR "$progname: executing " . join(' ', @cmd) . "\n"
220
my $exit_value = $? >> 8;
221
my $signal_num = $? & 127;
222
my $dumped_core = $? & 128;
223
error ("$cmd[0]: core dumped!") if ($dumped_core);
224
error ("$cmd[0]: signal $signal_num!") if ($signal_num);
225
error ("$cmd[0]: exited with $exit_value!") if ($exit_value);
232
if ($cmd =~ m@^\./|^/@) {
233
error ("cannot execute $cmd") unless (-x $cmd);
237
foreach my $dir (split (/:/, $ENV{PATH})) {
238
my $cmd2 = "$dir/$cmd";
239
print STDERR "$progname: checking $cmd2\n" if ($verbose > 3);
240
return $cmd2 if (-x "$cmd2");
242
error ("$cmd not found on \$PATH");
248
# Do some basic sanity checking (null text, null file names, etc.)
250
if (($text_mode eq 'literal' && $text_literal =~ m/^\s*$/i) ||
251
($text_mode eq 'file' && $text_file =~ m/^\s*$/i) ||
252
($text_mode eq 'program' && $text_program =~ m/^\s*$/i) ||
253
($text_mode eq 'url' && $text_url =~ m/^\s*$/i)) {
254
print STDERR "$progname: falling back to 'date'\n" if ($verbose);
258
if ($text_mode eq 'literal') {
259
$text_literal = strftime ($text_literal, localtime);
260
print STDOUT $text_literal;
261
print STDOUT "\n" unless ($text_literal =~ m/\n$/s);
263
} elsif ($text_mode eq 'file') {
266
if (open (IN, "<$text_file")) {
267
print STDERR "$progname: reading $text_file\n" if ($verbose);
269
if ($wrap_columns && $wrap_columns > 0) {
270
# read it, then reformat it.
272
while (<IN>) { $body .= $_; }
273
reformat_text ($body);
276
while (<IN>) { print $_; }
280
error ("$text_file: $!");
283
} elsif ($text_mode eq 'program') {
285
$text_program = which ($text_program);
286
print STDERR "$progname: running $text_program\n" if ($verbose);
288
if ($wrap_columns && $wrap_columns > 0) {
289
# read it, then reformat it.
290
my $body = `( $text_program ) 2>&1`;
291
reformat_text ($body);
294
safe_system ("$text_program");
297
} elsif ($text_mode eq 'url') {
299
get_url_text ($text_url);
301
} else { # $text_mode eq 'date'
303
safe_system ("uname", "-n");
304
if (-f "/etc/redhat-release") { system ("cat", "/etc/redhat-release"); }
305
safe_system ("uname", "-sr");
307
safe_system ("date", "+%c");
311
$ut =~ s/,\s*(load)/\n$1/;
318
# Loads the given URL, returns: $http, $head, $body.
321
my ($url, $referer) = @_;
323
if (! ($url =~ m@^http://@i)) {
324
error ("not an HTTP URL: $url");
327
my ($url_proto, $dummy, $serverstring, $path) = split(/\//, $url, 4);
328
$path = "" unless $path;
330
my ($them,$port) = split(/:/, $serverstring);
331
$port = 80 unless $port;
336
$serverstring = $http_proxy if $http_proxy;
337
$serverstring =~ s@^[a-z]+://@@;
338
($them2,$port2) = split(/:/, $serverstring);
339
$port2 = 80 unless $port2;
342
my ($remote, $iaddr, $paddr, $proto, $line);
344
if ($port2 =~ /\D/) { $port2 = getservbyname($port2, 'tcp') }
346
error ("unrecognised port in $url");
349
$iaddr = inet_aton($remote);
350
return ("error", "host not found", "$remote") unless ($iaddr);
352
$paddr = sockaddr_in($port2, $iaddr);
358
$proto = getprotobyname('tcp');
359
if (!socket(S, PF_INET, SOCK_STREAM, $proto)) {
360
error ("socket: $!");
362
if (!connect(S, $paddr)) {
363
return ("error", "connect($serverstring)", "$!");
366
select(S); $| = 1; select(STDOUT);
368
my $user_agent = "$progname/$version";
370
my $hdrs = ("GET " . ($http_proxy ? $url : "/$path") . " HTTP/1.0\r\n" .
372
"User-Agent: $user_agent\r\n");
374
$hdrs .= "Referer: $referer\r\n";
379
foreach (split('\r?\n', $hdrs)) {
380
print STDERR " ==> $_\n";
384
my $http = <S> || "";
388
print STDERR " <== $_\n" if ($verbose > 3);
394
print STDERR " <== $_\n" if ($verbose > 3);
397
print STDERR " <== \n" if ($verbose > 4);
401
print STDERR " <== $_" if ($verbose > 4);
406
print STDERR " <== [ body ]: $lines lines, " . length($body) . " bytes\n"
412
error ("null response: $url");
415
return ( $http, $head, $body );
419
# Loads the given URL, processes redirects, returns (content-type, body).
422
my ($url, $referer) = @_;
424
print STDERR "$progname: loading $url\n" if ($verbose > 2);
428
my $max_loop_count = 10;
431
my ( $http, $head, $body ) = get_url_1 ($url, $referer);
433
if ( $http eq "error" ) {
434
return ("error", "$head: $body");
437
$http =~ s/[\r\n]+$//s;
439
if ( $http =~ m@^HTTP/[0-9.]+ 30[123]@ ) {
442
my ( $location ) = m@^location:[ \t]*(.*)$@im;
444
$location =~ s/[\r\n]$//;
446
print STDERR "$progname: redirect from $url to $location\n"
453
$referer =~ m@^(http://[^/]+)@i;
455
} elsif (! ($url =~ m@^[a-z]+:@i)) {
457
s@[^/]+$@@g if m@^http://[^/]+/@i;
458
$_ .= "/" if m@^http://[^/]+$@i;
463
error ("no Location with \"$http\"");
466
if ($loop_count++ > $max_loop_count) {
467
error ("too many redirects ($max_loop_count) from $orig_url");
470
} elsif ( $http =~ m@^HTTP/[0-9.]+ ([4-9][0-9][0-9].*)$@ ) {
471
error ("failed: $1 ($url)");
474
my $ct = 'text/plain';
475
$ct = $1 if ($head =~ m/^content-type:\s*([^\s]+)/mi);
482
# Make an educated guess as to what's in this document.
483
# We don't necessarily take the Content-Type header at face value.
484
# Returns 'html', 'rss', or 'text';
486
sub guess_content_type {
487
my ($ct, $body) = @_;
489
$body =~ s/^(.{512}).*/$1/s; # only look in first half K of file
491
if ($ct =~ m@^text/.*html@i) { return 'html'; }
492
if ($ct =~ m@\b(atom|rss|xml)\b@i) { return 'rss'; }
494
if ($body =~ m@^\s*<\?xml@is) { return 'rss'; }
495
if ($body =~ m@^\s*<!DOCTYPE RSS@is) { return 'rss'; }
496
if ($body =~ m@^\s*<!DOCTYPE HTML@is) { return 'html'; }
498
if ($body =~ m@<(BASE|HTML|HEAD|BODY|SCRIPT|STYLE|TABLE|A\s+HREF)\b@i) {
502
if ($body =~ m@<(RSS|CHANNEL|GENERATOR|DESCRIPTION|CONTENT|FEED|ENTRY)\b@i) {
510
my ($body, $rss_p) = @_;
514
# In HTML, unfold lines (this breaks PRE. Sue me.)
515
# In RSS, assume \n means literal line break.
519
s@<!--.*?-->@@gsi; # lose comments
520
s@<(STYLE|SCRIPT)\b[^<>]*>.*?</\1\s*>@@gsi; # lose css and js
522
s@</?(BR|TR|TD|LI|DIV)\b[^<>]*>@\n@gsi; # line break at BR, TD, DIV, etc
523
s@</?(P|UL|OL|BLOCKQUOTE)\b[^<>]*>@\n\n@gsi; # two line breaks
525
s@<lj\s+user=\"?([^<>\"]+)\"?[^<>]*>?@$1@gsi; # handle <LJ USER=>
526
s@</?[BI]>@*@gsi; # bold, italic => asterisks
529
s@<[^<>]*>?@@gs; # lose all other HTML tags
530
$_ = de_entify ($_); # convert HTML entities
532
# elide any remaining non-Latin1 binary data...
533
s/([\177-\377]+(\s*[\177-\377]+)[^a-z\d]*)/�...� /g;
534
#s/([\177-\377]+(\s*[\177-\377]+)[^a-z\d]*)/�$1� /g;
538
s/[ \t]+$//gm; # lose whitespace at end of line
539
s@\n\n\n+@\n\n@gs; # compress blank lines
541
if (!defined($wrap_columns) || $wrap_columns > 0) {
542
$Text::Wrap::columns = ($wrap_columns || 72);
543
$_ = wrap ("", " ", $_); # wrap the lines as a paragraph
544
s/[ \t]+$//gm; # lose whitespace at end of line again
554
$body =~ s/(<(ITEM|ENTRY)\b)/\001\001$1/gsi;
555
my @items = split (/\001\001/, $body);
558
# Let's skip forward in the stream by a random amount, so that if
559
# two copies of ljlatest are running at the same time (e.g., on a
560
# multi-headed machine), they get different text. (Put the items
561
# that we take off the front back on the back.)
564
my $n = int (rand ($#items - 5));
566
push @items, (shift @items);
573
my ($title, $body1, $body2);
575
$title = $2 if (m@<(TITLE [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
576
$body1 = $3 if (m@<((DESCRIPTION) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
577
$body2 = $3 if (m@<((CONTENT) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi);
579
# If there are both <description> and <content> or <content:encoded>,
580
# use whichever one contains more text.
582
if ($body1 && $body2 && length($body2) >= length($body1)) {
586
next unless defined ($body1);
587
$title = rss_field_to_html ($title);
588
$body1 = rss_field_to_html ($body1);
590
reformat_html ("$title<P>$body1", 1);
596
sub rss_field_to_html {
599
# Assume that if <![CDATA[...]]> is present, everything inside that.
601
if ($body =~ m/^\s*<!\[CDATA\[(.*?)\]\s*\]/is) {
604
$body = de_entify ($body); # convert entities to get HTML from XML
607
$body = de_unicoddle ($body); # convert UTF8 to Latin1
615
# only re-wrap if --cols was specified. Otherwise, dump it as is.
617
if ($wrap_columns && $wrap_columns > 0) {
618
print STDERR "$progname: wrapping at $wrap_columns...\n" if ($verbose > 2);
619
$Text::Wrap::columns = $wrap_columns;
620
$body = wrap ("", "", $body);
621
$body =~ s/[ \t]+$//gm;
631
# historical suckage: the environment variable name is lower case.
632
$http_proxy = $ENV{http_proxy} || $ENV{HTTP_PROXY};
634
if ($http_proxy && $http_proxy =~ m@^http://([^/]*)/?$@ ) {
635
# historical suckage: allow "http://host:port" as well as "host:port".
639
my ($ct, $body) = get_url ($url);
640
if ($ct eq "error") {
646
$ct = guess_content_type ($ct, $body);
648
print STDERR "$progname: converting HTML...\n" if ($verbose > 2);
649
reformat_html ($body, 0);
650
} elsif ($ct eq 'rss') {
651
print STDERR "$progname: converting RSS...\n" if ($verbose > 2);
652
reformat_rss ($body);
654
print STDERR "$progname: plain text...\n" if ($verbose > 2);
655
reformat_text ($body);
663
print STDERR "$progname: $err\n";
668
print STDERR "usage: $progname [ --options ... ]\n" .
670
" Prints out some text for use by various screensavers,\n" .
671
" according to the options in the ~/.xscreensaver file.\n" .
672
" This may dump the contents of a file, run a program,\n" .
677
" --date Print the host name and current time.\n" .
679
" --text STRING Print out the given text. It may contain %\n" .
680
" escape sequences as per strftime(2).\n" .
682
" --file PATH Print the contents of the given file.\n" .
683
" If --cols is specified, re-wrap the lines;\n" .
684
" otherwise, print them as-is.\n" .
686
" --program CMD Run the given program and print its output.\n" .
687
" If --cols is specified, re-wrap the output.\n" .
689
" --url HTTP-URL Download and print the contents of the HTTP\n" .
690
" document. If it contains HTML, RSS, or Atom,\n" .
691
" it will be converted to plain-text.\n" .
693
" --cols N Wrap lines at this column. Default 72.\n" .
702
while ($#ARGV >= 0) {
704
if ($_ eq "--verbose") { $verbose++; }
705
elsif (m/^-v+$/) { $verbose += length($_)-1; }
706
elsif (m/^--?date$/) { $text_mode = 'date';
708
elsif (m/^--?text$/) { $text_mode = 'literal';
709
$text_literal = shift @ARGV;
711
elsif (m/^--?file$/) { $text_mode = 'file';
712
$text_file = shift @ARGV;
714
elsif (m/^--?program$/) { $text_mode = 'program';
715
$text_program = shift @ARGV;
717
elsif (m/^--?url$/) { $text_mode = 'url';
718
$text_url = shift @ARGV;
720
elsif (m/^--?col(umn)?s?$/) { $wrap_columns = 0 + shift @ARGV; }
721
elsif (m/^-./) { usage; }
725
get_prefs() if ($load_p);
added
removed
driver/xscreensaver-text
