diff options
| author | Simon Rettberg | 2024-09-06 14:42:37 +0200 |
|---|---|---|
| committer | Simon Rettberg | 2024-09-06 14:42:37 +0200 |
| commit | badef32037f52f79abc1f1440b786cd71afdf270 (patch) | |
| tree | 412b792d4cab4a7a110db82fcf74fe8a1ac55ec1 /driver/xscreensaver-text | |
| parent | Delete pre-6.00 files (diff) | |
| download | xscreensaver-master.tar.gz xscreensaver-master.tar.xz xscreensaver-master.zip | |
Diffstat (limited to 'driver/xscreensaver-text')
| -rwxr-xr-x | driver/xscreensaver-text | 899 |
1 files changed, 0 insertions, 899 deletions
diff --git a/driver/xscreensaver-text b/driver/xscreensaver-text deleted file mode 100755 index eca1fbf..0000000 --- a/driver/xscreensaver-text +++ /dev/null @@ -1,899 +0,0 @@ -#!/usr/bin/perl -w -# Copyright © 2005-2019 Jamie Zawinski <jwz@jwz.org> -# -# Permission to use, copy, modify, distribute, and sell this software and its -# documentation for any purpose is hereby granted without fee, provided that -# 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 -# implied warranty. -# -# This program writes some text to stdout, based on preferences in the -# .xscreensaver file. It may load a file, a URL, run a program, or just -# print the date. -# -# In a native MacOS build of xscreensaver, this script is included in -# the Contents/Resources/ directory of each screen saver .bundle that -# uses it; and in that case, it looks up its resources using -# /usr/bin/defaults instead. -# -# Created: 19-Mar-2005. - -require 5; -#use diagnostics; # Fails on some MacOS 10.5 systems -use strict; - -# Some Linux systems don't install LWP by default! -# Only error out if we're actually loading a URL instead of local data. -BEGIN { eval 'use LWP::UserAgent;' } - -# Not sure how prevalent this is. Hope it's part of the default install. -BEGIN { eval 'use HTML::Entities;' } - -use Socket; -use POSIX qw(strftime); -use Text::Wrap qw(wrap); -#use bytes; # This breaks shit. - -my $progname = $0; $progname =~ s@.*/@@g; -my ($version) = ('$Revision: 1.48 $' =~ m/\s(\d[.\d]+)\s/s); - -my $verbose = 0; -my $http_proxy = undef; - -my $config_file = $ENV{HOME} . "/.xscreensaver"; -my $text_mode = 'date'; -my $text_literal = ''; -my $text_file = ''; -my $text_program = ''; -my $text_url = 'https://en.wikipedia.org/w/index.php?title=Special:NewPages&feed=rss'; -# Default URL needs to be set and match what's in OSX/XScreenSaverView.m - -my $wrap_columns = undef; -my $truncate_lines = undef; -my $latin1_p = 0; -my $nyarlathotep_p = 0; - - -# Convert any HTML entities to Latin1 characters. -# -sub de_entify($) { - my ($text) = @_; - - return '' unless defined($text); - return $text unless ($text =~ m/&/s); - - # Convert any HTML entities to Unicode characters, - # if the HTML::Entities module is installed. - eval { - my $t2 = $text; - $text = undef; - $text = HTML::Entities::decode_entities ($t2); - }; - return $text if defined($text); - - # If it's not installed, just complain instead of trying to halfass it. - print STDOUT ("\n\tPerl is broken. Do this to repair it:\n" . - "\n\tsudo cpan HTML::Entities\n\n"); - exit (1); -} - - -# Convert any Unicode characters to Latin1 if possible. -# Unconvertable bytes are left alone. -# -sub utf8_to_latin1($) { - my ($text) = @_; - - utf8::encode ($text); # Unpack Unicode back to multi-byte UTF-8. - - # Maybe it would be better to handle this in the Unicode domain - # by doing things like s/\x{2018}/\"/g, but without decoding the - # string back to UTF-8 first, I'm at a loss as to how to have - # "á" print as "\340" instead of as "\303\240". - - $text =~ s/ \xC2 ( [\xA0-\xFF] ) / $1 /gsex; - $text =~ s/ \xC3 ( [\x80-\xFF] ) / chr (ord($1) | 0x40) /gsex; - - # Handles a few 3-byte sequences too. - $text =~ s/\xE2\x80\x93/--/gs; - $text =~ s/\xE2\x80\x94/--/gs; - $text =~ s/\xE2\x80\x98/`/gs; - $text =~ s/\xE2\x80\x99/'/gs; - $text =~ s/\xE2\x80\x9C/``/gs; - $text =~ s/\xE2\x80\x9D/'/gs; - $text =~ s/\xE2\x80\xA2/•/gs; - $text =~ s/\xE2\x80\xA6/.../gs; - $text =~ s/\xE2\x80\xB2/'/gs; - $text =~ s/\xE2\x84\xA2/™/gs; - $text =~ s/\xE2\x86\x90/ ← /gs; - - return $text; -} - - -# Reads the prefs we use from ~/.xscreensaver -# -sub get_x11_prefs() { - my $got_any_p = 0; - - if (open (my $in, '<', $config_file)) { - print STDERR "$progname: reading $config_file\n" if ($verbose > 1); - local $/ = undef; # read entire file - my $body = <$in>; - close $in; - $got_any_p = get_x11_prefs_1 ($body); - - } elsif ($verbose > 1) { - print STDERR "$progname: $config_file: $!\n"; - } - - if (! $got_any_p && defined ($ENV{DISPLAY})) { - # We weren't able to read settings from the .xscreensaver file. - # Fall back to any settings in the X resource database - # (/usr/X11R6/lib/X11/app-defaults/XScreenSaver) - # - print STDERR "$progname: reading X resources\n" if ($verbose > 1); - my $body = `appres XScreenSaver xscreensaver -1`; - $got_any_p = get_x11_prefs_1 ($body); - } - - if ($verbose > 1) { - print STDERR "$progname: mode: $text_mode\n"; - print STDERR "$progname: literal: $text_literal\n"; - print STDERR "$progname: file: $text_file\n"; - print STDERR "$progname: program: $text_program\n"; - print STDERR "$progname: url: $text_url\n"; - } - - $text_mode =~ tr/A-Z/a-z/; - $text_literal =~ s@\\n@\n@gs; - $text_literal =~ s@\\\n@\n@gs; -} - - -sub get_x11_prefs_1($) { - my ($body) = @_; - - my $got_any_p = 0; - $body =~ s@\\\n@@gs; - $body =~ s@^[ \t]*#[^\n]*$@@gm; - - if ($body =~ m/^[.*]*textMode:[ \t]*([^\s]+)\s*$/im) { - $text_mode = $1; - $got_any_p = 1; - } - if ($body =~ m/^[.*]*textLiteral:[ \t]*(.*?)[ \t]*$/im) { - $text_literal = $1; - } - if ($body =~ m/^[.*]*textFile:[ \t]*(.*?)[ \t]*$/im) { - $text_file = $1; - } - if ($body =~ m/^[.*]*textProgram:[ \t]*(.*?)[ \t]*$/im) { - $text_program = $1; - } - if ($body =~ m/^[.*]*textURL:[ \t]*(.*?)[ \t]*$/im) { - $text_url = $1; - } - - return $got_any_p; -} - - -sub get_cocoa_prefs($) { - my ($id) = @_; - my $v; - - print STDERR "$progname: reading Cocoa prefs: \"$id\"\n" if ($verbose > 1); - - $v = get_cocoa_pref_1 ($id, "textMode"); - $text_mode = $v if defined ($v); - - # The "textMode" pref is set to a number instead of a string because I - # couldn't figure out the black magic to make Cocoa bindings work right. - # - # Update: as of 5.33, Cocoa writes strings instead of numbers, but - # pre-existing saved preferences might still have numbers in them. - # - if ($text_mode eq '0') { $text_mode = 'date'; } - elsif ($text_mode eq '1') { $text_mode = 'literal'; } - elsif ($text_mode eq '2') { $text_mode = 'file'; } - elsif ($text_mode eq '3') { $text_mode = 'url'; } - elsif ($text_mode eq '4') { $text_mode = 'program'; } - - $v = get_cocoa_pref_1 ($id, "textLiteral"); - $text_literal = $v if defined ($v); - $text_literal =~ s@\\n@\n@gs; - $text_literal =~ s@\\\n@\n@gs; - - $v = get_cocoa_pref_1 ($id, "textFile"); - $text_file = $v if defined ($v); - - $v = get_cocoa_pref_1 ($id, "textProgram"); - $text_program = $v if defined ($v); - - $v = get_cocoa_pref_1 ($id, "textURL"); - $text_url = $v if defined ($v); -} - - -sub get_cocoa_pref_1($$) { - my ($id, $key) = @_; - # make sure there's nothing stupid/malicious in either string. - $id =~ s/[^-a-z\d. ]/_/gsi; - $key =~ s/[^-a-z\d. ]/_/gsi; - my $cmd = "defaults -currentHost read \"$id\" \"$key\""; - - print STDERR "$progname: executing $cmd\n" - if ($verbose > 3); - - my $val = `$cmd 2>/dev/null`; - $val =~ s/^\s+//s; - $val =~ s/\s+$//s; - - print STDERR "$progname: Cocoa: $id $key = \"$val\"\n" - if ($verbose > 2); - - $val = undef if ($val =~ m/^$/s); - - return $val; -} - - -# like system() but checks errors. -# -sub safe_system(@) { - my (@cmd) = @_; - - print STDERR "$progname: executing " . join(' ', @cmd) . "\n" - if ($verbose > 3); - - system @cmd; - my $exit_value = $? >> 8; - my $signal_num = $? & 127; - my $dumped_core = $? & 128; - error ("$cmd[0]: core dumped!") if ($dumped_core); - error ("$cmd[0]: signal $signal_num!") if ($signal_num); - error ("$cmd[0]: exited with $exit_value!") if ($exit_value); -} - - -sub which($) { - my ($cmd) = @_; - - if ($cmd =~ m@^\./|^/@) { - error ("cannot execute $cmd") unless (-x $cmd); - return $cmd; - } - - foreach my $dir (split (/:/, $ENV{PATH})) { - my $cmd2 = "$dir/$cmd"; - print STDERR "$progname: checking $cmd2\n" if ($verbose > 3); - return $cmd2 if (-x "$cmd2"); - } - error ("$cmd not found on \$PATH"); -} - - -sub output() { - - binmode (STDOUT, ($latin1_p ? ':raw' : ':utf8')); - binmode (STDERR, ':utf8'); - - # Do some basic sanity checking (null text, null file names, etc.) - # - if (($text_mode eq 'literal' && $text_literal =~ m/^\s*$/i) || - ($text_mode eq 'file' && $text_file =~ m/^\s*$/i) || - ($text_mode eq 'program' && $text_program =~ m/^\s*$/i) || - ($text_mode eq 'url' && $text_url =~ m/^\s*$/i)) { - print STDERR "$progname: falling back to 'date'\n" if ($verbose); - $text_mode = 'date'; - } - - if ($text_mode eq 'literal') { - $text_literal = strftime ($text_literal, localtime); - $text_literal = utf8_to_latin1($text_literal) if ($latin1_p); - $text_literal =~ y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p); - print STDOUT $text_literal; - print STDOUT "\n" unless ($text_literal =~ m/\n$/s); - - } elsif ($text_mode eq 'file') { - - $text_file =~ s@^~/@$ENV{HOME}/@s; # allow literal "~/" - - if (open (my $in, '<:raw', $text_file)) { - print STDERR "$progname: reading $text_file\n" if ($verbose); - binmode (STDOUT, ':raw'); - - if (($wrap_columns && $wrap_columns > 0) || $truncate_lines) { - # read it, then reformat it. - local $/ = undef; # read entire file - my $body = <$in>; - $body = reformat_text ($body); - print STDOUT $body; - } else { - # stream it by lines - while (<$in>) { - $_ = utf8_to_latin1($_) if ($latin1_p); - y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p); - print STDOUT $_; - } - } - close $in; - } else { - error ("$text_file: $!"); - } - - } elsif ($text_mode eq 'program') { - - my ($prog, $args) = ($text_program =~ m/^([^\s]+)(.*)$/); - $text_program = which ($prog) . $args; - print STDERR "$progname: running $text_program\n" if ($verbose); - - if (($wrap_columns && $wrap_columns > 0) || $truncate_lines) { - # read it, then reformat it. - my $lines = 0; - my $body = ""; - my $cmd = "( $text_program ) 2>&1"; - # $cmd .= " | sed -l"; # line buffer instead of 4k pipe buffer - open (my $pipe, '-|:unix', $cmd); - while (my $line = <$pipe>) { - $body .= $line; - $lines++; - last if ($truncate_lines && $lines > $truncate_lines); - } - close $pipe; - - # I don't understand why we must do this here, but must not do this - # in the 'file' branch above, which reads the file with :raw... - utf8::decode ($body); # Pack multi-byte UTF-8 back into wide chars. - - $body = reformat_text ($body); - print STDOUT $body; - } else { - # stream it - safe_system ("$text_program"); - } - - } elsif ($text_mode eq 'url') { - - get_url_text ($text_url); - - } else { # $text_mode eq 'date' - - my $n = `uname -n`; - $n =~ s/\.local\n/\n/s; - print $n; - - my $unamep = 1; - - if (-f "/etc/redhat-release") { # "Fedora Core release 4 (Stentz)" - safe_system ("cat", "/etc/redhat-release"); - } - - if (-f "/etc/release") { # "Solaris 10 3/05 s10_74L2a X86" - safe_system ("head", "-1", "/etc/release"); - } - - if (-f "/usr/sbin/system_profiler") { # "Mac OS X 10.4.5 (8H14)" - my $sp = # "iMac G5" - `/usr/sbin/system_profiler SPSoftwareDataType SPHardwareDataType 2>/dev/null`; - # system_profiler on OS X 10.10 generates spurious error messages. - my ($v) = ($sp =~ m/^\s*System Version:\s*(.*)$/mi); - my ($s) = ($sp =~ m/^\s*(?:CPU|Processor) Speed:\s*(.*)$/mi); - my ($t) = ($sp =~ m/^\s*(?:Machine|Model) Name:\s*(.*)$/mi); - print "$v\n" if ($v); - print "$s $t\n" if ($s && $t); - $unamep = !defined ($v); - } - - if ($unamep) { - safe_system ("uname", "-sr"); # "Linux 2.6.15-1.1831_FC4" - } - - print "\n"; - safe_system ("date", "+%c"); - print "\n"; - my $ut = `uptime`; - $ut =~ s/^[ \d:]*(am|pm)?//i; - $ut =~ s/,\s*(load)/\n$1/; - print "$ut\n"; - } - -} - - -# Make an educated guess as to what's in this document. -# We don't necessarily take the Content-Type header at face value. -# Returns 'html', 'rss', or 'text'; -# -sub guess_content_type($$) { - my ($ct, $body) = @_; - - $body =~ s/^(.{512}).*/$1/s; # only look in first half K of file - - if ($ct =~ m@^text/.*html@i) { return 'html'; } - if ($ct =~ m@\b(atom|rss|xml)\b@i) { return 'rss'; } - - if ($body =~ m@^\s*<\?xml@is) { return 'rss'; } - if ($body =~ m@^\s*<!DOCTYPE RSS@is) { return 'rss'; } - if ($body =~ m@^\s*<!DOCTYPE HTML@is) { return 'html'; } - - if ($body =~ m@<(BASE|HTML|HEAD|BODY|SCRIPT|STYLE|TABLE|A\s+HREF)\b@i) { - return 'html'; - } - - if ($body =~ m@<(RSS|CHANNEL|GENERATOR|DESCRIPTION|CONTENT|FEED|ENTRY)\b@i) { - return 'rss'; - } - - return 'text'; -} - - -sub reformat_html($$) { - my ($body, $rss_p) = @_; - $_ = $body; - - # In HTML, try to preserve newlines inside of PRE. - # - if (! $rss_p) { - s@(<PRE\b[^<>]*>\s*)(.*?)(</PRE)@{ - my ($a, $b, $c) = ($1, $2, $3); - $b =~ s/[\r\n]/<BR>/gs; - $a . $b . $c; - }@gsexi; - } - - if (! $rss_p) { - # In HTML, unfold lines. - # In RSS, assume \n means literal line break. - s@[\r\n]@ @gsi; - } - - # This right here is the part where I doom us all to inhuman - # toil for the One whose Name cannot be expressed in the - # Basic Multilingual Plane. http://jwz.org/b/yhAT He comes. - - s@<!--.*?-->@@gsi; # lose comments - s@<(STYLE|SCRIPT)\b[^<>]*>.*?</\1\s*>@@gsi; # lose css and js - - s@</?(BR|TR|TD|LI|DIV)\b[^<>]*>@\n@gsi; # line break at BR, TD, DIV, etc - s@</?(P|UL|OL|BLOCKQUOTE)\b[^<>]*>@\n\n@gsi; # two line breaks - - s@<lj\s+user=\"?([^<>\"]+)\"?[^<>]*>?@$1@gsi; # handle <LJ USER=> - s@</?[BI]>@*@gsi; # bold, italic => asterisks - - - s@<[^<>]*>?@@gs; # lose all other HTML tags - $_ = de_entify ($_); # convert HTML entities - - # For Wikipedia: delete anything inside {{ }} and unwrap [[tags]], - # among other things. - # - if ($rss_p eq 'wiki') { - - s@<!--.*?-->@@gsi; # lose HTML comments again - - # Creation line is often truncated: screws up parsing with unbalanced {{. - s@(: +[^a-zA-Z ]* *Created page) with [^\n]+@$1@s; - - s@/\*.*?\*/@@si; # /* ... */ - - # Try to omit all tables, since they're impossible to read as text. - # - 1 while (s/\{\{[^{}]*}}/ /gs); # {{ ... }} - 1 while (s/\{\|.*?\|\}/\n\n/gs); # {| ... |} - 1 while (s/\|-.*?\|/ /gs); # |- ... | (table cell) - - # Convert anchors to something more readable. - # - s/\[\[([^\[\]\|]+)\|([^\[\]]+)\]\]/$2/gs; # [[link|anchor]] - s/\[\[([^:\[\]\|]+)\]\]/$1/gs; # [[anchor]] - s/\[https?:[^\[\]\s]+\s+([^\[\]]+)\]/$1/gs; # [url anchor] - - # Convert all references to asterisks. - s@\s*<ref>\s*.*?</ref>@*@gs; # <ref> ... <ref> -> "*" - s@\n[ \t]*\d+\s*\^\s*http[^\s]+[ \t]*\n@\n@gs; # 1 ^ URL (a Reflist) - - s@\[\[File:([^\|\]]+).*?\]\]@\n$1\n@gs; # [[File: X | ... ]] - s@\[\[Category:.*?\]\]@@gs; # omit categories - - s/<[^<>]*>//gs; # Omit all remaining tags - s/\'{3,}//gs; # Omit ''' and '''' - s/\'\'/\"/gs; # '' -> " - s/\`\`/\"/gs; # `` -> " - s/\"\"+/\"/gs; # "" -> " - - s/^[ \t]*[*#]+[ \t]*$//gm; # Omit lines with just * or # on them - - # Omit trailing headlines with no text after them (e.g. == Notes ==) - 1 while (s/\n==+[ \t]*[^\n=]+[ \t]*==+\s*$/\n/s); - - $_ = de_entify ($_); # convert HTML entities, again - } - - - # elide any remaining non-Latin1 binary data. - if ($latin1_p) { - utf8::encode ($_); # Unpack Unicode back to multi-byte UTF-8. - s/([^\000-\176]+(\s*[^\000-\176]+)[^a-z\d]*)/\xAB...\xBB /g; - } - - $_ .= "\n"; - - s/[ \t]+$//gm; # lose whitespace at end of line - s@\n\n\n+@\n\n@gs; # compress blank lines - - if (!defined($wrap_columns) || $wrap_columns > 0) { - $Text::Wrap::columns = ($wrap_columns || 72); - $Text::Wrap::break = '[\s/|]'; # wrap on slashes for URLs - $_ = wrap ("", " ", $_); # wrap the lines as a paragraph - s/[ \t]+$//gm; # lose whitespace at end of line again - } - - s/^\n+//gs; - - if ($truncate_lines) { - s/^(([^\n]*\n){$truncate_lines}).*$/$1/s; - } - - $_ = utf8_to_latin1($_) if ($latin1_p); - y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p); - - return $_; -} - - -sub reformat_rss($) { - my ($body) = @_; - - my $wiki_p = ($body =~ m@<generator>[^<>]*Wiki@si); - - $body =~ s/(<(ITEM|ENTRY)\b)/\001\001$1/gsi; - my @items = split (/\001\001/, $body); - - print STDERR "$progname: converting RSS ($#items items)...\n" - if ($verbose > 2); - - shift @items; - - # Let's skip forward in the stream by a random amount, so that if - # two copies of ljlatest are running at the same time (e.g., on a - # multi-headed machine), they get different text. (Put the items - # that we take off the front back on the back.) - # - if ($#items > 7) { - my $n = int (rand ($#items - 5)); - print STDERR "$progname: rotating by $n items...\n" if ($verbose > 2); - while ($n-- > 0) { - push @items, (shift @items); - } - } - - my $out = ''; - - my $i = -1; - foreach (@items) { - $i++; - - my ($title, $author, $body1, $body2, $body3); - - $title = $3 if (m@<((TITLE) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi); - $author= $3 if (m@<((DC:CREATOR) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi); - $body1 = $3 if (m@<((DESCRIPTION) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi); - $body2 = $3 if (m@<((CONTENT) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi); - $body3 = $3 if (m@<((SUMMARY) [^<>\s]*)[^<>]*>\s*(.*?)\s*</\1>@xsi); - - # If there are both <description> and <content> or <content:encoded>, - # use whichever one contains more text. - # - if ($body3 && length($body3) >= length($body2 || '')) { - $body2 = $body3; - } - if ($body2 && length($body2) >= length($body1 || '')) { - $body1 = $body2; - } - - if (! $body1) { - if ($title) { - print STDERR "$progname: no body in item $i (\"$title\")\n" - if ($verbose > 2); - } else { - print STDERR "$progname: no body or title in item $i\n" - if ($verbose > 2); - next; - } - } - - $title = rss_field_to_html ($title || ''); - $author= rss_field_to_html ($author || ''); - $body1 = rss_field_to_html ($body1 || ''); - - $title = '' if ($body1 eq $title); # Identical in Twitter's atom feed. - - # Omit author if it's in the title or body - $author = '' if ($author && - ($title =~ m/\Q$author\E/si || - $body1 =~ m/\Q$author\E/si)); - - $title = $author if ($author && !$title); - $title = "$author: $title" if ($author && $title); - - $out .= reformat_html ("$title<P>$body1", $wiki_p ? 'wiki' : 'rss'); - $out .= "\n"; - } - - if ($truncate_lines) { - $out =~ s/^(([^\n]*\n){$truncate_lines}).*$/$1/s; - } - - return $out; -} - - -sub rss_field_to_html($) { - my ($body) = @_; - - # If <![CDATA[...]]> is present, everything inside that is HTML, - # and not double-encoded. - # - if ($body =~ m/^\s*<!\[CDATA\[(.*?)\]\s*\]/is) { - $body = $1; - } else { - $body = de_entify ($body); # convert entities to get HTML from XML - } - - return $body; -} - - -sub reformat_text($) { - my ($body) = @_; - - # only re-wrap if --cols was specified. Otherwise, dump it as is. - # - if ($wrap_columns && $wrap_columns > 0) { - print STDERR "$progname: wrapping at $wrap_columns...\n" if ($verbose > 2); - $Text::Wrap::columns = $wrap_columns; - $Text::Wrap::break = '[\s/]'; # wrap on slashes for URLs - $body = wrap ("", "", $body); - $body =~ s/[ \t]+$//gm; - } - - if ($truncate_lines) { - $body =~ s/^(([^\n]*\n){$truncate_lines}).*$/$1/s; - } - - $body = utf8_to_latin1($body) if ($latin1_p); - $body =~ y/A-Za-z/N-ZA-Mn-za-m/ if ($nyarlathotep_p); - return $body; -} - - -# Figure out what the proxy server should be, either from environment -# variables or by parsing the output of the (MacOS) program "scutil", -# which tells us what the system-wide proxy settings are. -# -sub set_proxy($) { - my ($ua) = @_; - - my $proxy_data = `scutil --proxy 2>/dev/null`; - foreach my $proto ('http', 'https') { - my ($server) = ($proxy_data =~ m/\b${proto}Proxy\s*:\s*([^\s]+)/si); - my ($port) = ($proxy_data =~ m/\b${proto}Port\s*:\s*([^\s]+)/si); - my ($enable) = ($proxy_data =~ m/\b${proto}Enable\s*:\s*([^\s]+)/si); - - if ($server && $enable) { - # Note: this ignores the "ExceptionsList". - my $proto2 = 'http'; - $ENV{"${proto}_proxy"} = ("${proto2}://" . $server . - ($port ? ":$port" : "") . "/"); - print STDERR "$progname: MacOS $proto proxy: " . - $ENV{"${proto}_proxy"} . "\n" - if ($verbose > 2); - } - } - - $ua->env_proxy(); -} - - -sub get_url_text($) { - my ($url) = @_; - - my $ua = eval 'LWP::UserAgent->new'; - - if (! $ua) { - print STDOUT ("\n\tPerl is broken. Do this to repair it:\n" . - "\n\tsudo cpan LWP::UserAgent" . - " LWP::Protocol::https Mozilla::CA\n\n"); - return; - } - - # Half the time, random Linux systems don't have Mozilla::CA installed, - # which results in "Can't verify SSL peers without knowning which - # Certificate Authorities to trust". - # - # I'm going to take a controversial stand here and say that, for the - # purposes of plain-text being displayed in a screen saver via RSS, - # the chances of a certificate-based man-in-the-middle attack having - # a malicious effect on anyone anywhere at any time is so close to - # zero that it can be discounted. So, just don't bother validating - # SSL connections. - # - $ENV{'PERL_LWP_SSL_VERIFY_HOSTNAME'} = 0; - eval { - $ua->ssl_opts (verify_hostname => 0, SSL_verify_mode => 0); - }; - - - set_proxy ($ua); - $ua->agent ("$progname/$version"); - my $res = $ua->get ($url); - my $body; - my $ct; - - if ($res && $res->is_success) { - $body = $res->decoded_content || ''; - $ct = $res->header ('Content-Type') || 'text/plain'; - - } else { - my $err = ($res ? $res->status_line : '') || ''; - $err = 'unknown error' unless $err; - $err = "$url: $err"; - # error ($err); - $body = "Error loading URL $err\n\n"; - $ct = 'text/plain'; - } - - # This is not necessary, since HTTP::Message::decoded_content() has - # already done 'decode (<charset-header>, $body)'. - # utf8::decode ($body); # Pack multi-byte UTF-8 back into wide chars. - - $ct = guess_content_type ($ct, $body); - if ($ct eq 'html') { - print STDERR "$progname: converting HTML...\n" if ($verbose > 2); - $body = reformat_html ($body, 0); - } elsif ($ct eq 'rss') { - $body = reformat_rss ($body); - } else { - print STDERR "$progname: plain text...\n" if ($verbose > 2); - $body = reformat_text ($body); - } - print STDOUT $body; -} - - - -sub error($) { - my ($err) = @_; - print STDERR "$progname: $err\n"; - exit 1; -} - -sub usage() { - print STDERR "usage: $progname [ --options ... ]\n" . - ("\n" . - " Prints out some text for use by various screensavers,\n" . - " according to the options in the ~/.xscreensaver file.\n" . - " This may dump the contents of a file, run a program,\n" . - " or load a URL.\n". - "\n" . - " Options:\n" . - "\n" . - " --date Print the host name and current time.\n" . - "\n" . - " --text STRING Print out the given text. It may contain %\n" . - " escape sequences as per strftime(2).\n" . - "\n" . - " --file PATH Print the contents of the given file.\n" . - " If --cols is specified, re-wrap the lines;\n" . - " otherwise, print them as-is.\n" . - "\n" . - " --program CMD Run the given program and print its output.\n" . - " If --cols is specified, re-wrap the output.\n" . - "\n" . - " --url HTTP-URL Download and print the contents of the HTTP\n" . - " document. If it contains HTML, RSS, or Atom,\n" . - " it will be converted to plain-text.\n" . - "\n" . - " --cols N Wrap lines at this column. Default 72.\n" . - "\n" . - " --lines N No more than N lines of output.\n" . - "\n" . - " --latin1 Emit Latin1 instead of UTF-8.\n" . - "\n"); - exit 1; -} - -sub main() { - - my $load_p = 1; - my $cocoa_id = undef; - - while ($#ARGV >= 0) { - $_ = shift @ARGV; - if ($_ eq "--verbose") { $verbose++; } - elsif (m/^-v+$/) { $verbose += length($_)-1; } - elsif (m/^--?date$/) { $text_mode = 'date'; - $load_p = 0; } - elsif (m/^--?text$/) { $text_mode = 'literal'; - $text_literal = shift @ARGV || ''; - $text_literal =~ s@\\n@\n@gs; - $text_literal =~ s@\\\n@\n@gs; - $load_p = 0; } - elsif (m/^--?file$/) { $text_mode = 'file'; - $text_file = shift @ARGV || ''; - $load_p = 0; } - elsif (m/^--?program$/) { $text_mode = 'program'; - $text_program = shift @ARGV || ''; - $load_p = 0; } - elsif (m/^--?url$/) { $text_mode = 'url'; - $text_url = shift @ARGV || ''; - $load_p = 0; } - elsif (m/^--?col(umn)?s?$/) { $wrap_columns = 0 + shift @ARGV; } - elsif (m/^--?lines?$/) { $truncate_lines = 0 + shift @ARGV; } - elsif (m/^--?cocoa$/) { $cocoa_id = shift @ARGV; } - elsif (m/^--?latin1$/) { $latin1_p++; } - elsif (m/^--?nyarlathotep$/) { $nyarlathotep_p++; } - elsif (m/^-./) { usage; } - else { usage; } - } - - if ($load_p) { - - if (!defined ($cocoa_id)) { - # see OSX/XScreenSaverView.m - $cocoa_id = $ENV{XSCREENSAVER_CLASSPATH}; - } - - if (defined ($cocoa_id)) { - get_cocoa_prefs($cocoa_id); - } else { - get_x11_prefs(); - } - } - - output(); - - - if (defined ($cocoa_id)) { - # - # On MacOS, sleep for 10 seconds between when the last output is - # printed, and when this process exits. This is because MacOS - # 10.5.0 and later broke ptys in a new and exciting way: basically, - # once the process at the end of the pty exits, you have exactly - # 1 second to read all the queued data off the pipe before it is - # summarily flushed. - # - # Many of the screen savers were written to depend on being able - # to read a small number of bytes, and continue reading until they - # reached EOF. This is no longer possible. - # - # Note that the current MacOS behavior has all four of these - # awesome properties: 1) Inconvenient; 2) Has no sane workaround; - # 3) Different behavior than MacOS 10.1 through 10.4; and 4) - # Different behavior than every other Unix in the world. - # - # See http://jwz.org/b/DHke, and for those of you inside Apple, - # "Problem ID 5606018". - # - # One workaround would be to rewrite the savers to have an - # internal buffer, and always read as much data as possible as - # soon as a pipe has input available. However, that's a lot more - # work, so instead, let's just not exit right away, and hope that - # 10 seconds is enough. - # - # This will solve the problem for invocations of xscreensaver-text - # that produce little output (e.g., date-mode); and won't solve it - # in cases where a large amount of text is generated in a short - # amount of time (e.g., url-mode.) - # - sleep (10); - } -} - -main(); -exit 0; |
