- Name
- E2 piecemaker proxy
- Description
- Personal web proxy that adds some user-side features to E2 UI.
- Features
- Gag out the "Ack! You lost experience!" message: Out of eyes, out of mind
- Play a sound file on "Ack! You lost experience!" message:
Positive conditioning
- "Vote reason" boxes next to voting buttons:
How many times have you heard someone say "if they just told the reason
for downvote..."?
- "Preview" checkbox next to "Don't display on ENN" checkbox:
Integrated Preview
- Alternative random node: If you're tired of Brian Eno and Webster 1913
- Chatterbox word substitution:
/msh EDB good morning EDB, it's <time> and I'm feeling spooky
You said "good morning EDB, it's 02:50 and I'm feeling spooky" to EDB
- Chatterbox ignore: Ready to kill at mention of XP?
- Mail This Node: The best of "people who ...", delivered straight to your friend's mailbox
- Availability
- Requirements:
- perl (5.6.0 used)
- NetServer::Generic perl module (try CPAN)
- Mail::Sender perl module (optional)
- CGI perl module (usually ships with perl)
Might work in ActiveState perl on win32, but I haven't tested it so no guarantees.
To download, either copy&paste the code below (and mutilate it as described in E2 node tracker (are these shameless plugs starting to annoy
you? :P)) or download it from http://iki.fi/kaatunut/E2proxy.pl.
- Usage
- Once you have the script, put it somewhere. It doesn't really matter where the script is (/usr/local/bin is just as good a place as any...), only
where you run it; the configuration will be stored and loaded from the directory you run it in, not from your home directory.
Now, just run it; it will automatically guide you through the configuration process. Shouldn't be too much of a problem. Once it's configured, just run
it and all is well. You may use ./E2proxy.pl >E2proxy.log & to put it in background.
Note that the configurator program can't be used to change existing configuration (one can only bear so much user friendliness coding...);
you must either use that gray mass and edit .E2proxy directly, or ditch your configuration and rerun ./E2proxy.pl -configure.
Note: You can, however, store your finetuned Chatterbox Word Substitutions, Random Node ranges etc. It's a bit clumsy, but here's what you have to do:
- Use -configure to set your favourite substitutions and whatnot.
- Open .E2proxy
- Copy the parts you want to save to another file. For example, here is a theoretical configuration file, with parts a theoretical file owner will
save to "MyE2proxy.conf" in bold:
$port = 4505;
$E2home = 'everything2.com';
$noack = 1;
$ack_sound = 'multipart';
$ack_url = '/tmp/cuckoo.wav';
$votebox = 1;
$preview = 1;
$altrandom = 1;
@altrandom_ban = (
[
373825,
376884
],
[
'1',
'1000'
]
);
%chatterwatch = (
'<time>' => 'POSIX::strftime("%H:%M",localtime)',
'microsoft' => [
'microsloth',
'macrosoft',
'micro$oft',
'mikkisofta'
],
'<perl>(.*?)</perl>' => 'eval($1)',
);
%ignore_names = (
'kaatunut' => 'ignore'
);
@ignore_body = (
'XP',
'downvot(ed|ing)'
);
$mailnode_mode = 'smtp';
$mailnode_smtpserver = 'posti.saunalahti.fi';
$mailnode_email = 'kaatunut@iki.fi';
- Rerun ./E2proxy.pl -configure
- Edit .E2proxy, and to end this: include "MyE2proxy.conf";
- Voila! Now your old configuration overrides the new partly.
- History
-
- End notes
- Sheesh, publishing code in E2 is only for lunatics and idiots. Ever tried to fit your uber-cool regexps in 80 character columns?...
The Source:
#!/usr/bin/perl -w
use strict;
# TODO: node view history
# TODO: node vide statistics
# * typical targets
# TODO: voting statistics
# * +/- ratio
# * typical targets
use NetServer::Generic;
use CGI qw(escape unescape);
sub HandleReq;
our $webster_start=177707;
our $webster_end=363651;
our $winerr_start=373825;
our $winerr_end=376884;
our $port=4505;
our $E2home="everything2.com";
my %mailaction=(
"mailto" => "mailto: ",
"smtp" => "/");
my %mailadd=(
"mailto" => "",
"smtp" => "<input type=hidden name=op value=smtp>");
my %mailsubmit=(
"mailto" => <<EOT,
<input type=button value='Open' onClick='document.location=
"mailto:"+escape(document.mailto.to.value)+
"?from="+escape(document.mailto.from.value)+
"&subject="+escape(document.mailto.subject.value)+
"&body="+escape(document.mailto.body.value)'>
EOT
"smtp" => "<input type=submit value='Send'>");
our($noack,$ack_sound,$ack_url,$votebox,$preview,$altrandom);
our @altrandom_ban;
our %chatterwatch;
our %ignore_names;
our @ignore_body;
our($mailnode_mode,$mailnode_smtpserver,$mailnode_email,$node_num);
my %conf_var = (
"port" => [ \$port, 1, ],
"server" => [ \$E2home, 1, ],
);
my $argnum=scalar @ARGV;
my($i,$t);
my($no_conf,$conf_filename);
for ($i=0; $i<=$#ARGV; $i++) { # pre-config pass
if ($ARGV[$i] eq "-q") {
$no_conf=1;
splice @ARGV,$i,1;
$i--;
} elsif ($ARGV[$i] eq "-conf") {
$conf_filename=$ARGV[++$i];
}
}
sub include {
my $r;
print STDERR "parse error in include: $@" unless ($r=do $_[0]) || defined($r);
return $r;
}
unless ($no_conf) {
$conf_filename||=".E2proxy";
unless (-e $conf_filename) {
unless ($argnum) {
print
"You don't seem to have configured.\n".
"Would you like to (note: run with -q to avoid this) [yes]? ";
unless (chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "n") {
push @ARGV,"-configure";
}
} else {
die "can't open $conf_filename!";
}
} else {
include $conf_filename;
}
}
while (@ARGV) {
next unless substr($ARGV[0],0,1) eq "-";
$t=substr(shift(@ARGV),1);
if ($t eq "help") {
print <<EOT
E2 piecemaker proxy 0.1
Usage: $0 [possibly some parameters]
This script functions as your personal proxy that may, among its many other
functions, keep peace in war-stricken E2.
-configure Interactive (re)configuration
-conf FILENAME Use FILENAME instead of ".E2proxy" for configuration
-q Don't use configuration file at all ('tis a proxy too)
-port N Port to twiddle in. Put to 1024+ if you have access
privilege problems. Defaults to 4505.
-server HOST Endpart of E2 server's host address. Defaults to
"everything2.com" (which covers www.everything2.com)
Note: There are more features, but you must use config file to use them.
Try '$0 -configure'.
Notes:
This likely does not work with all the theme settings. You at least
should use full writeup display.
Vote box:
The box looks like it was generated by E2 engine, but don't let this
fool you into thinking writing something in it means E2 will do the
message. It won't. Instead, this same proxy server intercepts the
messages written in that box when you hit 'vote!', removes them from
outgoing message and then proceeds to create some /msg requests on its
own. If you have many messages to send, experience badly timed network
outages, bad luck or bug in this proxy, message(s) won't get delivered.
Don't count on this to deliver messages about your innards or anything
else important.
P.S. No, I can't create anonymous /msg's (well, I might send them
over [everyone] ... but I don't want to), the messages have
your name in them. Take responsibility or leave the box empty,
in which case no message will get sent. Put a single space in the
box if you want to just send notification about vote direction
(+, -, O).
Alt. random:
Alternative random -button bypasses E2 server's mechanism completely and
instead randomizes a node_id and inquires for that. This has it upsides
and downsides:
Upside: It gives you more control- since all major nodespaces (ie. webster,
error codes) are autonoded in batch, their node_ids are more or
less consecutive. Therefore, with proper "ban" ranges for node_id
randomization they can be largely avoided.
Downsides: Both nodes and writeups are accessed through their node_ids
("writeups" are in fact nodes too), so this randomization gives
you specific writeups instead of entire nodes often. Also, since
nuking a writeup leaves a "hole" in node_id continuity, you will
occasionally get just errors because the node_id you tried isn't
there.
Also, you must have 'Statistics' nodelet enabled. (well, you COULD set
\$node_num=700000; or whatever in the config file... but that gets clumsy)
Finally, send comments, bug reports, ideas and/or hallucinations you had last
morning to kaatunut\@iki.fi.
-Kaatunut, 8.12 - 20.12.2000
EOT
;
exit;
} elsif ($t eq "configure") {
ServerConf();
ClientConf();
} elsif (exists $conf_var{$t}) {
${$conf_var{$t}[0]}=$conf_var{$t}[1]==0 ? 1 :
(!@ARGV || substr($ARGV[0],0,1 eq "-")) ? "" :
shift(@ARGV)
} else {
print "Unknown option '$t'!\n";
}
}
sub ServerConf {
print <<EOT;
Server configuration
====================
EOT
print "Enter port the proxy server should use [$port]: ";
chomp($_=<STDIN>),$_ and $port=$_;
print "Enter endpart of preferred E2 hostname [$E2home]: ";
chomp($_=<STDIN>),$_ and $E2home=$_;
chomp($_=<<EOT); print;
Gag Ack!
--------
Some people seem to experience severe pain at the face of the infamous
"Ack! You lost experience!" message. Pain leads to fear, fear leads to
hate and you know the drill.
Do you want to have the \"Ack! You lost experience!\" gagged out [no]?
EOT
chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "y" and $noack=1;
chomp($_=<<EOT); print;
Ack! sounds
-----------
On the other hand, psychological tests have proven that hearing a cheerful
sound such as "cuckoo!" or "ding! you have lost experience!" can easily
reverse the pain-hate-destruction cycle of Ack!.
Do you want to configure playing sounds on events [no]?
EOT
if (chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "y") {
chomp($_=<<EOT); print;
There are currently as many as 5 (actually 4) ways to play sounds (don't blame
me, it's all capitalism's fault):
1. 'play'ing sounds on server machine
- obviously, this only makes sense if you're running the server on local machine
- plays files from local computer
- easy to configure
=> recommended for most Linux users
2. 'multipart' HTTP transfers
- plays files from local computer
- doesn't require plugins
- doesn't work on IE (?)
3. 'autodetect' embedded sound tags
- requires JavaScript
- like 4 and 5, but autodetects between NS and IE
=> recommended for mobile users
4. 'embed' sound tags
- no JavaScript needed
- works on standards-compliant browser (no IE, then)
- needs a sound plugin
- plays files from anywhere in Internet (eg. a web site with WAV files)
5. 'bgsound' sound tags
- no JavaScript needed
- works only on IE
- might need plugins
- plays files from anywhere in Internet (eg. a web site with WAV files)
Which one shall it be [autodetect]?
EOT
my $t;
chomp($t=lc <STDIN>);
if ($t eq "bgsound" || $t eq "5") {
$ack_sound="bgsound";
print
"Give me a full URL to a sound to play (http:// and the drill required):\n";
chomp($ack_url=<STDIN>);
} elsif ($t eq "embed" || $t eq "4") {
$ack_sound="embed";
print
"Give me an URL to a sound to play (http:// and the drill required):\n";
chomp($ack_url=<STDIN>);
} elsif ($t eq "multipart" || $t eq "2") {
$ack_sound="multipart";
print
"Give me the path to a local sound file to send & play:\n";
chomp($ack_url=<STDIN>);
} elsif ($t eq "play" || $t eq "1") {
$ack_sound="play";
print
"Give me the path to a local sound file to play:\n";
chomp($ack_url=<STDIN>);
} else {
$ack_sound="autodetect";
print
"Give me an URL to a sound to play (http:// and the drill required):\n";
chomp($ack_url=<STDIN>);
}
}
chomp($_=<<EOT); print;
Automatic vote reason /msg's
----------------------------
It has been constant cause of grief for some people that not only people vote
their nodes down, they don't even tell you the reason for vote. In some cases
the reason is mere convenience. To obliterate this excuse, we (I and perl)
provide you with option of "vote boxes". If enabled, little text fields will
appear next to vote buttons; if you write something in this field, it will
automatically get /msg'd to the writeup's owner along with the information
on which way you voted.
Do you want vote boxes enabled [yes]?
EOT
chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "n" or $votebox=1;
chomp($_=<<EOT);print;
Integrated Preview
------------------
It's not exactly uncommon to make a *liittle* mistake in your node text, which
will result in node's formatting being a total mess. When you submit a node,
you will have, depending on time of day, from 30 seconds to 5 minutes time to
fix the node. To counter this sumbit sinking feeling, several previewers
have been written, but I doubt any can beat this in integration: Enabling this
will cause little checkbox "preview" appear below "Don't display in New
Writeups" checkbox. Check it, and 'submit' will first take you to a page
viewing what (approximately) node would look like. You can then confirm it or
hit 'back' and fix your node.
Warning: If my code sucks, this program crashes (unlikely with perl...) et
cetera, you will lose the node. Deal with it. This is propably less likely
than losing it to usual browser crashes, though ...
Note: Forbidden tags are not parsed out and E2 font is not used. Might do that
before hell freezes over, call back when they next debate over when the
millennium really changes.
Do you want to enable node preview [yes]?
EOT
chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "n" or $preview=1;
chomp($_=<<EOT);print;
Random Node
-----------
It is unknown whether some people just want to bitch about everything or if
this actually is a real problem, but common complaint about Random Node is
that it will unproportionately often take you to Brian Eno and/or Windows
Error Codes and Webster 1913 have flooded the nodespace. For those who consider
this a serious problem that is threatening E2's existence, we (me and my
imaginary friends with green hats) have provided you an Alternative Random Node.
Pros: You can configure it to avoid certain node_id ranges. It has guaranteed
unbiased randomization, although you should get a radioactive decay
measuring device just be sure.
Cons: It will take you often to individual writeups instead of large 'node'
views, and even more often to nonexistent nodes ("that's strange, nothing
here").
Do you want to enable and configure Alternative Random Node [no]?
EOT
if (chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "y") {
$altrandom=1;
print
"Do you want to exclude using preconfigure node_id range...\n".
" Webster 1913 nodes [no]? ";
chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "y" and
push @altrandom_ban,[$webster_start,$webster_end];
print
" Windows Error Codes [no]? ";
chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "y" and
push @altrandom_ban,[$winerr_start,$winerr_end];
while (
print("Enter node_id range to exclude from Alt. Random (or empty to quit): "),
chomp($_=<STDIN>),$_) {
if (!/^\s*(\d+)\s*-\s*(\d+)/) {
print "Usage: number - number\n";
next;
}
push @altrandom_ban,[$1,$2];
}
}
chomp($_=<<EOT);print;
Chatter word substitution
-------------------------
Some people have problem with their language in chatterbox. Some people keep
mistyping "/msg", revealing private messages to the world. Some people gain
endless enjoyment from weird hacks to embed dynamic information into their
speech. What do these people have in common? They all could use our (mine and
magician's best friend's) chatterbox speech substitutor.
Do you want to configure chatterbox word substitutor [no]?
EOT
if (chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "y") {
print <<EOT;
There are three (technically two) sorts of substitutions: Word-to-word(s), and
dynamic. Simplest form is to type in a word and then another which will replace
the first one. Typical use for this would be, for example, "^/msh " => "/msg ".
The "^" there is regexp symbol signifying beginning of line, so that /msh won't
be typo corrected in sentences like "do you often type /msh when you mean
/msg?".
Second form (which is really same as first) is giving in *many* substitutions,
of which one will be picked randomly. Randomness implies humour, and indeed,
typical use could be, for example, "microsoft" => "micro\$oft", "microsloth".
Third form is actual perl code. I won't bother explaining it here; if you're
interested, try www.perl.com, man perl or closest book store for title
"learning perl". But if you already know perl, let it be known that code you
type will be eval'd in RHS of s///e; that is, return a string to substitute,
\$& is the word you wanted to substitute and \$1, \$2, ... are submatches
(if any).
EOT
while (1) {
my($word,$perl);
print "\nEnter a word to substitute or empty to quit: ";
chomp($word=<STDIN>),$word or last;
$chatterwatch{$word}=();
print
"Do you want to substitute it with 'perl' expression or 'words' [words]? ";
chomp($_=<STDIN>),$_ and $_ eq "perl" and $perl=1;
unless ($perl) {
while (1) {
print "Enter a substitution (empty to quit): ";
chomp($_=<STDIN>),$_ or last;
push @{$chatterwatch{$word}},$_;
}
} else {
print "Enter perl code. EOT to quit.\n";
$chatterwatch{$word}=join " ",
map { chomp($_); $_ }
<STDIN>;
}
}
}
chomp($_=<<EOT); print;
Chatterbox ignore
-----------------
Despite your best attempts to embrace the world as it comes, sometimes you come
across people who really piss you off. Or maybe some people just talk too much
and say too little to suit you. Or maybe you are totally sick and tired of
everything involving XP and are ready to kill anyone who mentions downvoting in
chatterbox? Go for peaceful solution...
Do you want to configure chatterbox ignoring services [no]?
EOT
if (chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "y") {
print
"\nYou can ignore messages by on person or content. We'll start with persons.\n";
while (1) {
print "Enter a name of person to ignore or empty to continue: ";
chomp($_=<STDIN>),$_ or last;
$ignore_names{$_}='ignore';
}
while (1) {
print
"Enter a regexp to ignore message body or empty to quit: ";
chomp($_=<STDIN>),$_ or last;
push @ignore_body,$_;
}
}
chomp($_=<<EOT); print;
Mail This Node
--------------
Sharing is good. Promoting E2 website is good. Generous use of HTML formatting
in nodes is (generally) good. Cut&pasting nodes to quote them to a friends,
losing the original formatting, is not good.
Do you want to enable and configure "mail this node" feature [yes]?
EOT
unless (chomp($_=<STDIN>),$_ and lc(substr($_,0,1) eq "n")) {
REMAIL:
chomp($_=<<EOT); print;
There are currently two ways to mail nodes. One uses browser's configured
messaging through "mailto:" URLs, the other accesses mail server directly.
"mailto" mechanism is good in such that it requires no configuration from
you, but it's not certain your browser *is* configured for sending email. If
it is, feel free to choose "mailto", but note that mailto also requires
JavaScript support. This shouldn't be problem unless you're lynx user or time
traveller. Also, mailto isn't a good idea if you plan to use public machines
such as library, work or school computers.
"SMTP" mechanism send mails directly through the server. If you're going to
use this proxy from public machines, this is a great idea, and if you're lynx
user, this is your only choice. However, you need to have certain perl module
to use this.
Do you want to use mailto or SMTP mails [mailto]?
EOT
if (chomp($_=<STDIN>),$_ and lc($_) eq "smtp") {
$mailnode_mode="smtp";
unless (eval "require Mail::Sender") {
print <<EOT;
I can't find Mail::Sender perl module, which is required for SMTP mail sending.
You must fetch and install it from CPAN. One way to do this is to head to
http://search.cpan.org, search for Mail::Sender, download and install it. Other
is to run (as root)
perl -MCPAN -e shell
and type there
install Mail::Sender
If both sound too complicated for you, give up and use "mailto".
EOT
goto REMAIL;
}
print "Mail::Sender module OK.\n";
do {
print "Outgoing SMTP server? ";
} until (chomp($_=<STDIN>),$_);
$mailnode_smtpserver=$_;
} else {
$mailnode_mode="mailto";
}
print "Your email address? ";
chomp($_=<STDIN>),$mailnode_email=$_;
}
print "\nDo you want to save the settings [yes]? ";
unless (chomp($_=<STDIN>),$_ and lc substr($_,0,1) eq "n") {
do {
print "Enter file name [$conf_filename]: ";
(chomp($_=<STDIN>),$_) and $conf_filename=$_;
unless (open(FH,">$conf_filename")) {
print "Can't open $conf_filename!\n";
redo;
}
print FH <<EOT;
# Configuration for for E2 piecemaker
#
# It is automatically created by configuration program, but feel free to edit.
# Syntax should be fairly self-explanatory, if it isn't, use -configure more
# and come back then, but be warned, configurator will overwrite this file.
#
# This file is technically perl code so you could do anything here, not only
# configuration. Use this power wisely.
#
# Also, you may include configuration from other files with
# include "filename"
EOT
print FH Data::Dumper->Dump(
[$port, $E2home, $noack, $ack_sound, $ack_url, $votebox,
$preview, $altrandom, $altrandom && \@altrandom_ban,
\%chatterwatch, \%ignore_names, \@ignore_body,
$mailnode_mode, $mailnode_smtpserver, $mailnode_email,
],
[qw(port E2home noack ack_sound ack_url votebox
preview altrandom *altrandom_ban
*chatterwatch *ignore_names *ignore_body
mailnode_mode mailnode_smtpserver mailnode_email
)]);
close(FH);
print
"Saved. Edit file '$conf_filename' for further modifications.\n";
} while (0);
}
}
sub ClientConf {
print
"\nFor local proxy use (the typical case), client requires some configuration.\n".
"Do you want to configure it now (only Netscape supported for now) [yes]? ";
return if chomp($_=<STDIN>),$_ and $_ eq "no";
print<<EOT;
Client Configuration
====================
EOT
my $prefname="$ENV{'HOME'}/.netscape/preferences.js";
if (-e $prefname) {
print "Netscape preferences.js file found.\n";
}
print "Enter the path to preferences.js [$prefname]: ";
chomp($_=<STDIN>),$_ and $prefname=$_;
if (! -e $prefname) {
print "$prefname not found, creating...\n";
open(FILE,">$prefname");
close(FILE);
}
open(FILE,$prefname) or die "can't open $prefname";
my %prefs;
my %prefs_change;
my $pac=<<EOT;
function FindProxyForURL(url,host) {
if (shExpMatch(url,"http:*") && dnsDomainIs(host,"$E2home")) {
return "PROXY 127.0.0.1:$port";
}
EOT
while (<FILE>) {
chomp;
if (/^\s*user_pref\(\s*"([^"]*)"\s*,\s*(?:(")([^"]*)"|([^)\s]*))\s*\);/) {
$prefs{$1}=[ $3||$4, $2 ];
}
}
close(FILE);
if (exists $prefs{'network.proxy.autoconfig_url'} &&
$prefs{'network.proxy.autoconfig_url'}[0] =~ /E2proxy\.pac$/) {
print "E2 proxy already configured, skipping ...\n";
} else {
print<<EOT;
Proxy
-----
E2 personal proxy is a... proxy. Program that functions both as server and
client; you send it a request to get a page from E2, it does so, modifies
the document received and then gives the result to you. This should happen
mostly transparently to you, so that it will seem as if E2 had automagically
transformed.
To accomplish this, we're going to tamper with your browser's configuration
files a bit and generate an automatic proxy configuration file (PAC).
EOT
if (exists $prefs{'network.proxy.autoconfig_url'}) {
print
"It seems you already are using Netscape's autoproxy feature for something\n".
"else. E2 personal web proxy can't function unless you let me overwrite it.\n".
"\nMay I overwrite it [no]? ";
if (chomp($_=<STDIN>),$_ and $_ eq "yes") {
undef $prefs{'network.proxy.autoconfig_url'};
} else {
print "Well, goodbye then.\n";
exit;
}
}
$prefs{'network.proxy.type'}[0] ||= 0;
if (exists $prefs{'network.proxy.no_proxies_on'}) {
for $i (split / /,$prefs{'network.proxy.no_proxies_on'}[0]) {
$pac.=<<EOT;
if (dnsDomainIs(host,"$i")) {
return "DIRECT";
}
EOT
}
}
my @pv= grep /^network\.proxy\.(?:ftp|gopher|http|ssl|wais)$/,
keys %prefs;
if (@pv) {
print "\nYou seem to have manual proxy already configured";
if ($prefs{'network.proxy.type'}[0] != 1) {
print " (although it's not currently in use)";
}
chomp($_=<<EOT); print;
.
I could include that configuration into the automatic configuration or
just leave it alone (you can't use your original proxy settins together with
E2 personal proxy if you do).
Shall I include the manual proxy configuration [yes]?
EOT
unless (chomp($_=<STDIN>),$_ and $_ eq "no") {
for $i (@pv) {
my($t) = $i=~/^network\.proxy\.(\w+)$/;
$t eq "ssl" and $t="https";
$pac.=<<EOT;
if (shExpMatch(url,"$t:*")) {
return "PROXY $prefs{$i}[0]:$prefs{"${i}_port"}[0]; DIRECT";
}
EOT
}
}
}
$pac.=<<EOT;
return "DIRECT";
}
EOT
$prefs_change{'network.proxy.autoconfig_url'}=
[ "$ENV{'HOME'}/.netscape/E2proxy.pac", '"'];
$prefs_change{'network.proxy.type'}=[2, undef];
open(FILE,">$prefs_change{'network.proxy.autoconfig_url'}[0]")
or die "can't open PAC for writing";
print FILE $pac;
close(FILE);
print "$prefs_change{'network.proxy.autoconfig_url'}[0] written.\n";
}
if ($ack_sound && $ack_sound eq "multipart") {
print<<EOT;
Sound helper
------------
You have selected the 'multipart' method of playing sounds. It requires the
client either have helper application or plugin for audio/wav. You don't need
to configure helper applications if you have sound plugin such as Plugger
installed.
EOT
print "Do you want to configure helper applications [yes]? ";
unless (chomp($_=<STDIN>),$_ and $_ eq "no") {
# ^^^^^^ funny how unintuitive 'unless' can sometimes be...
unless (exists $prefs{'helpers.private_mime_types_file'} &&
-e $prefs{'helpers.private_mime_types_file'}[0]) {
my $name=exists($prefs{'helpers.private_mime_types_file'}) ?
$prefs{'helpers.private_mime_types_file'}[0] :
"$ENV{'HOME'}/.mime.types";
print
"\nYou don't seem to have MIME types file. To continue, I need to create one.\n".
"\nShould I give up, or shall I create $name for you [yes]? ";
# hmmh, bad language, but I want to conserve at least SOME space, dammit
if (chomp($_=<STDIN>),$_ and $_ eq "no") {
print "Well, goodbye then.\n";
exit;
}
open(FILE,">$name") or die "can't open $name for writing";
print FILE "type=audio/wav\nexts=\"wav\"\n";
close(FILE);
$prefs_change{'helpers.private_mime_types_file'}=[ $name, '"' ];
print "$name created.\n";
} else {
my $name=$prefs{'helpers.private_mime_types_file'}[0];
open(FILE,$name)
or die "can't open MIME types file (shouldn't happen)";
my $t;
while (<FILE>) {
chomp;
$t=1,last if m!^type=audio/wav!;
}
unless ($t) {
close(FILE);
open(FILE,">>$name")
or die "can't change MIME types file (?!?!)";
print FILE "type=audio/wav\nexts=\"wav\"\n";
print "$name modified.\n";
}
close(FILE);
}
unless (exists $prefs{'helpers.private_mailcap_file'} &&
-e $prefs{'helpers.private_mailcap_file'}[0]) {
my $name=exists($prefs{'helpers.private_mailcap_file'}) ?
$prefs{'helpers.private_mailcap_file'}[0] :
"$ENV{'HOME'}/.mailcap";
print
"\nYou don't seem to have mailcap file. To continue, I need to create one.\n".
"\nShould I give up, or shall I create $name for you [yes]? ";
if (chomp($_=<STDIN>),$_ and $_ eq "no") {
print "Well, goodbye then.\n";
exit;
}
open(FILE,">$name") or die "can't open $name for writing";
print FILE "audio/wav;play -t wav %s\n";
close(FILE);
$prefs_change{'helpers.private_mailcap_file'}=[$name, '"'];
print "$name created.\n";
} else {
my $name=$prefs{'helpers.private_mailcap_file'}[0];
open(FILE,$name)
or die "can't change mailcap file (shouldn't happen)";
my $t;
while (<FILE>) {
chomp;
$t=1,last if m!^audio/wav;!;
}
unless ($t) {
close(FILE);
open(FILE,">>$name")
or die "can't change mailcap file (hmmmmmm)";
print FILE "audio/wav;play -t wav %s\n";
print "$name modified.\n";
}
close(FILE);
}
}
}
open(FILE,$prefname) or die "can't open $prefname";
open(OUT,">$prefname.tmp") or die "can't open $prefname.tmp";
while (<FILE>) {
chomp;
if (/^\s*user_pref\(\s*"([^"]*)"\s*,\s*(?:(")([^"]*)"|([^)\s]*))\s*\);/) {
if (exists $prefs_change{$1}) {
print OUT "user_pref(\"$1\", ";
print OUT '"' if $prefs_change{$1}[1];
print OUT $prefs_change{$1}[0];
print OUT '"' if $prefs_change{$1}[1];
print OUT ");\n";
delete $prefs_change{$1};
} else {
print OUT "$_\n";
}
} else {
print OUT "$_\n";
}
}
for $i (sort keys %prefs_change) {
print OUT "user_pref(\"$i\", ";
print OUT '"' if $prefs_change{$i}[1];
print OUT $prefs_change{$i}[0];
print OUT '"' if $prefs_change{$i}[1];
print OUT ");\n";
}
close(OUT);
close(FILE);
system("mv -f $prefname.tmp $prefname");
}
if ($mailnode_mode eq "smtp") {
require Mail::Sender;
}
$SIG{CHLD}="IGNORE";
# names changed to pretend this isn't from man NetServer::Generic
my $serv=new NetServer::Generic;
$serv->port($port);
$serv->callback(\&HandleReq);
$serv->mode("forking");
print "Starting server\n";
$serv->run();
sub playAck {
my $r;
if (!defined ($r=fork)) {
print STDERR "forking error\n";
} elsif (!$r) {
open(STDOUT,">&STDERR");
# print STDERR "playing $ack_url\n";
exec "play","$ack_url" or die "can't invoke play!";
}
}
sub HandleReq {
my $line=<STDIN>;
my($i,$j);
my $self=shift;
my ($mailnode_this,$mailnode_type);
# names changed to protect the guilty (me)
unless
($line =~ m!^(\w+)\s+http://(.*?)(?::(\d+))?(?:(/\S*?)(?:\?(\S*))?)?\s+(\S+)!) {
print "HTTP/1.0 400 Bad Request\nConnection: close\n\n";
print "HTTP/1.0 400 Bad Request\n";
return;
}
my($method,$server,$port,$path,$query,$protocol)
=($1,$2,$3||80,$4||"/",$5||"",$6);
print STDERR "request received to $server with $method\n";
my %headers;
my $c=0;
local $/="\r\n";
while (<STDIN>) {
chomp;
last if /^$/;
if (/^([^:]*):\s*(.*?)\s*$/) {
$headers{lc $1}=[$c++, $1, $2] ;
}
}
if (lc($method) eq "post") {
unless (exists $headers{"content-length"}) {
print "HTTP/1.0 400 Bad Request\nConnection:close\n\n";
print "POST request without Content-length field\n";
return;
} else {
local $/=\$headers{"content-length"}[2];
$query=<STDIN>;
}
}
if (exists $headers{"connection"}) {
delete $headers{lc $headers{"connection"}[2]};
delete $headers{"connection"};
}
if (exists $headers{"proxy-connection"}) {
delete $headers{"proxy-connection"};
}
unless (exists $headers{"content-type"}) {
$headers{"content-type"}=
[$c++,"Content-type", "application/x-www-form-urlencoded"];
}
my $cookie=exists($headers{"cookie"}) ? $headers{"cookie"}[2] : "";
if ($query &&
(lc($method) ne "post" ||
(lc($method) eq "post" &&
lc($headers{"content-type"}[2]) eq
"application/x-www-form-urlencoded")) &&
$server =~ /$E2home$/) {
# print STDERR "tampering with query\n";
my $q=new CGI($query);
if ($preview && $q->param("writeup_preview")) {
my($type,$body);
for $i qw(idea person place thing) {
if (defined $q->param("writeuptype-$i.x")) {
$type="writeuptype-$i";
last;
}
}
$body=$q->param("writeup_doctext");
$body =~
s!\[(?:(.*?)\|)?(.*?)\]!"<a href=\"#".($1||$2)."\">$2</a>"!ge;
print
"HTTP/1.0 200 OK\nContent-Type: text/html\n\n",
"<html><head>\n",
"<link rel=\"stylesheet\" type=\"text/css\" href=styledef.css>\n",
"</head><body>\n",
"writeup_notnew: ",$q->param("writeup_notnew"),"<br>\n",
"writeup type: $type<br>\n",
"writeup_doctext:<p><hr><p>\n$body<p><hr><p>\n",
"<form method=POST enctype='application/x-www-form-urlencoded'>\n";
for $i ($q->param()) {
next if $i eq "writeup_doctext" || $i eq "writeup_preview";
print
"<input type=hidden name=$i value=\"".$q->param($i)."\">\n";
}
print
"<TEXTAREA NAME=\"writeup_doctext\" ROWS=20 COLS=60 wrap=virtual>",
$q->param("writeup_doctext"),
"</TEXTAREA>\n";
print "<input type=submit value=\"submit (for real)\">\n";
print "</form>\n";
print "</body></html>";
return;
}
if (keys(%chatterwatch) && ($q->param("op")||"") eq "message") {
for $i (keys %chatterwatch) {
$q->param_fetch("message")->[0] =~
s/$i/ref($chatterwatch{$i})
? $chatterwatch{$i}[rand(@{$chatterwatch{$i}})]
: eval($chatterwatch{$i})
/ge;
}
}
if ($votebox && ($q->param("op")||"") eq "vote") {
for $i ($q->param()) {
if ($i =~ /^comment_(\d+)_([^&]*)&(.*)$/) {
if ($q->param($i)) {
my($nid,$title,$name)=($1,$2,$3);
$name =~ tr/ /_/;
my $message=
"/msg $name ".
($q->param("vote__$nid")
? $q->param("vote__$nid")>0 ? "+voted" : "-voted"
: "not voted").
" on [".
unescape($title).
"]".
($q->param($i) ne " "
? ("-- ".$q->param($i))
: "");
my $r;
$SIG{CHLD}="IGNORE";
if (!defined($r=fork)) {
print STDERR "forking error\n";
} elsif (!$r) { # child
open(STDOUT,">/dev/null");
open(STDIN,"/dev/null");
my $msgsock=new IO::Socket::INET(
PeerAddr=>$server,
PeerPort=>$port,
Proto=>"tcp",
);
if (!$msgsock) {
print STDERR "child failed to send /msg\n";
exit;
}
print $msgsock "GET /?op=message&message=".
escape($message).
" HTTP/1.0\n";
print $msgsock "Cookie: $cookie\n\n";
# closing socket too soon might not send (?)
while (<$msgsock> && !/^\r?\n$/) { }
close($msgsock);
print STDERR "sent: $message\n";
exit;
}
}
$q->delete($i);
}
}
}
if ($altrandom && ($q->param("op")||"") eq "altrandomnode") {
$q->delete("op");
my $n;
do {
$n=int rand $q->param("node_num");
} while (grep { $n>$$_[0] && $n<$$_[1] }
@altrandom_ban);
$q->param_fetch("node_id")->[0]=$n;
$q->delete("node_num");
}
if ($mailnode_mode && ($q->param("op")||"") eq "mailnode") {
$q->delete("op");
$mailnode_this=$q->param("node_id");
$mailnode_type=$q->param("type");
$q->delete("type");
} elsif ($mailnode_mode && ($q->param("op")||"") eq "smtp") {
$q->delete("op");
my $sender=new Mail::Sender {
smtp => $mailnode_smtpserver,
from => $q->param("from"),
to => $q->param("to"),
subject => $q->param("subject"),
cc => $q->param("cc"),
bcc => $q->param("bcc"),
headers => "Content-type: text/html",
};
unless (ref($sender)) {
$Mail::Sender::Error=$Mail::Sender::Error;
print
"<html><body>SMTP mailer creation error\n",
"code: $Mail::Sender::Error ($sender)</body></html>\n";
return;
}
$sender->MailMsg($q->param("body"));
print "<html><body>Node mailed</body></html>\n";
return;
}
$query=join "&",
map { escape($_)."=".escape($q->param($_)) }
$q->param();
}
print STDERR "connecting to $server:$port ...\n";
my $sock=new IO::Socket::INET(
PeerAddr=>$server,
PeerPort=>$port,
Proto =>"tcp",
);
if (!$sock) {
print <<EOT;
HTTP/1.0 504 Gateway Timeout
Connection: close
Can't connect to target server: $server at port $port.
EOT
print STDERR "couldn't connect to $server:$port\n";
return;
}
if (lc($method) eq "post") {
$headers{"content-length"}[2]=length $query;
}
my $head=
join '',
map { "$headers{$_}[1]: $headers{$_}[2]\r\n" }
sort { $headers{$a}[0] <=> $headers{$b}[0] } keys %headers;
undef %headers;
my $req="$method $path".
(($query && lc($method) eq "get") ? "?$query" : "").
" $protocol\r\n";
my $out="$req$head\r\n";
$out.=$query if lc($method) eq "post";
print $sock $out;
undef $head;
my $body="";
if ($server !~ /$E2home$/) {
print STDERR "tunneling: server is $server\n";
while (<$sock>) {
print;
}
close($sock);
return;
}
my $statline;
chomp($statline=<$sock>);
while (<$sock>) {
chomp;
last if /^$/;
if (/^([^:]*):\s*(.*?)\s*$/) {
$headers{lc $1}=[$c++, $1, $2] ;
}
}
local $/=undef;
$body=<$sock>;
close($sock);
# I think this had some problems but I can't remember what so I'm leaving it
# enabled
$body =~ tr/\r//d;
my @multipart_add; # [ $content_type, $entity-body ]
# [ "text/html", $body ] is considered the first element
# depending on query, change or replace
if ($mailnode_mode) {
unless ($mailnode_this) {
$body =~ s!
<h1\sclass=topic>[^<]*</h1>\n
\n
<FORM\s[^>]*>\n
<INPUT\sTYPE="hidden"\sNAME="node_id"\sVALUE="([^"]*)"><INPUT\s[^>]*>\n
<TABLE\s[^>]*>\n
!
$&.
"<p align=right>".
"<a href=\"/?op=mailnode&node_id=$1&type=node\">".
"mail this node</a></p>\n"
!exi;
$body =~ s!
(<td><b>
\(<A\sHREF="/index.pl\?node_id=(\d+)&[^>]*>
[^<]*</a>\)
\sby <A\sHREF=[^>]*>[^<]*</a></b>\n
</td>\n
<td\salign=right>.*?</td><td\salign=right>)
(<font\ssize=2>
\w+\s+\w+\s+\d+\s+\d+\s+at\s+\d+:\d+\s+\w+\s*
</font></td>\n
</tr></table>)
!
$1.
"<a href='/?op=mailnode&node_id=$2&type=writeup'>mail this writeup</a><br>".
$3
!gexi;
} else {
if ($body =~ m!<h1 class=topic>([^<]*)</h1>!) {
my $nodename=$1;
my $nodebody="";
while ($body =~ m!
<td><b>
\(<A\sHREF="/index.pl\?node_id=(\d+)&[^>]*>
([^<]*)</a>\)\s
by <A\sHREF=[^>]*>([^<]*)</a></b>\n
</td>\n
<td\salign=right>
.*?
</td>
<td\salign=right>
<font\ssize=2>
\w+\s+\w+\s+\d+\s+\d+\s+at\s+\d+:\d+\s+\w+\s*
</font></td>\n
</tr></table>\n?
</td></tr>\n?
<tr><td\svalign=top>(?:\n\s\s)?
<br>
(.*?)<br><br>\n
\s*</td>
!xsig) {
next if $mailnode_type eq "writeup" && $1 != $mailnode_this;
my $wu_nid=$1;
my $wu_type=$2;
my $wu_owner=$3;
my $wu_body=$4;
my $wu_name=$mailnode_type eq "writeup"
? $nodename
: "$nodename ($wu_type)";
$wu_body =~
s!<a href="/index.pl\?!<a href="http://$E2home/index.pl?!gi;
$nodebody.=<<EOT;
<a href="http://$E2home/?node_id=$wu_nid">$wu_name</a><br>
by $wu_owner @ <a href="http://$E2home">$E2home</a>:<p>
$wu_body<p>
<hr><p>
EOT
last if $mailnode_type eq "writeup";
}
$body=<<EOT;
<html><head>
<title>Mail node to a friend - $nodename</title>
</head>
<body><form method=POST action="$mailaction{$mailnode_mode}" name=mailto>
$mailadd{$mailnode_mode}
<table>
<tr>
<td>From:</td>
<td><input type=text name=from value='$mailnode_email' size=30></td>
</tr>
<tr>
<td>To:</td>
<td><input type=text name=to size=30></td>
</tr>
<tr>
<td>CC:</td>
<td><input type=text name=cc size=30></td>
</tr>
<tr>
<td>BCC:</td>
<td><input type=Text name=bcc size=30></td>
</tr><tr>
<td>Subject:</td>
<td><input type=text name=subject value='$nodename' size=50></td>
</tr>
</table>
Message:<p>
<textarea name=body cols=60 rows=20>
$nodebody
</textarea><p>
$mailsubmit{$mailnode_mode}
</form>
</body></html>
EOT
}
}
}
# change
if ($noack || $ack_sound) {
if ($body =~ m#<a href=[^>]*>Cool Archive#msi) {
my $ack=0;
substr($body,length $`) =~
s{<br><font size=2>Ack! You lost experience!.*?</font><br>}{
($ack=1),$noack ? "" : $&
}msie;
if ($ack && $ack_sound) {
if ($ack_sound eq "play") {
playAck();
} elsif ($ack_sound eq "multipart") {
unless (open(FILE,$ack_url)) {
print STDERR "!! can't open $ack_url\n";
} else {
local $/=undef;
my $slurp=<FILE>;
close(FILE);
push @multipart_add, ["audio/wav", $slurp];
}
} elsif ($ack_sound eq "autodetect") {
$body =~ s!</body>!<<EOT!ei;
<script language="JavaScript"><!--
if (navigator.appName == "Microsoft Internet Explorer") {
document.write("<bgsound src=\\"$ack_url\\">");
} else if (navigator.appName == "Netscape") {
document.write("<embed src=\\"$ack_url\\" hidden>");
}
// -->
</script>
$&
EOT
} elsif ($ack_sound eq "embed") {
$body =~ s!</body>!<<EOT!ei;
<embed src="$ack_url" hidden>
$&
EOT
} elsif ($ack_sound eq "bgsound") {
$body =~ s!</body>!<<EOT!ei;
<bgsound src="$ack_url">
$&
EOT
}
}
}
}
# change
if ($votebox) {
my($title)= $body =~ /<h1 class=topic>([^<]*)<\/h1>/g;
if ($body =~ /<h2 class=topic>go back to/g) {
($title) = $title =~ /^(.*?) \([^)]*\)$/;
}
$body =~ s!
by <a[^>]*?>([^<]*?)</a></b>\n
</td>\n
<td\s[^>]*><font\s[^>]*>
<INPUT\stype=radio\sname='vote__(\d+)'\svalue='1'>\s\+
<INPUT\stype=radio\sname='vote__\2'\svalue='-1'>\s-
(?:<INPUT\stype=radio\schecked\sname='vote__\2'\svalue='0'\s>\sO</font>)?
(?:\s<b><a\s[^>]*>C\!</a></b>)?
!
$&.
" <input type=text name='comment_$2_".
escape($title).
"&".
escape($1)."' size=15>"
!gisxe;
}
# change
if (@ignore_body || keys %ignore_names) {
if ($body =~ m#<img [^>]*(?<= alt="Chatterbox")>#) {
my($t1,$t2);
substr($body,length $`) =~ s!
(?:
<b><</b>
<A\sHREF=[^>]*>([^<]*)</a>
<b>></b>\s
(.*?)<br>
|
<i><A\sHREF=[^>]*>([^<]*)</a>\s
(.*?)</i><br>
)
!
($t1,$t2)=($1 || $3,$2 || $4),
exists $ignore_names{$t1} ||
grep($t2 =~ /$_/,@ignore_body) ?
"" : $&
!gexi;
}
}
# change
if ($preview) {
$body =~ s!
<INPUT\sTYPE=checkbox\sNAME=writeup_notnew\sVALUE=1>
\(Don't\sdisplay\sin\s"New\sWriteups"\)
!
$&."<br><input type=checkbox name=writeup_preview value=1> preview"
!iex;
}
# change
if ($altrandom) {
if (!$node_num) {
if ($body =~
m!<td><b>nodes</b>: </td><td>(\d+)</td>!i) {
$node_num=$1;
}
}
if ($node_num) {
$body =~ s!
<a href=[^>]*
(?<=op=randomnode")>
Random Node<br></a>
!
$&.
"<a href=\"/?node_num=$node_num&op=altrandomnode\">
Alt. Random Node</a><br>"
!iex;
}
}
$headers{"content-length"}=
[(exists($headers{'content-type'})
? $headers{"content-type"}[0]
: 1000)-1,
"Content-Length",
length $body
];
if (@multipart_add) {
my @charset=('A' .. 'Z','a' .. 'z','0' .. '9');
my $boundary=join '',map { $charset[rand(@charset)] } ( 1 .. 20 );
my @content_keys=sort { $headers{$a}[0] <=> $headers{$b}[0] }
grep /^content-/i,
keys %headers;
my $nb="--$boundary\r\n";
for $i (@content_keys) {
$nb.="$headers{$i}[1]: $headers{$i}[2]\r\n";
delete $headers{$i};
}
$nb.="\r\n$body";
$headers{"content-type"}=[ 1000, "Content-Type",
"multipart/mixed;boundary=$boundary"];
for $j (@multipart_add) {
$nb.="\r\n--$boundary\r\nContent-type: $j->[0]\r\n\r\n$j->[1]";
}
$nb.="\r\n--$boundary--";
$body=$nb;
}
$head=
join '',
map { "$headers{$_}[1]: $headers{$_}[2]\r\n" }
sort { $headers{$a}[0] <=> $headers{$b}[0] }
keys %headers;
undef %headers;
print "$statline\r\n$head\r\n$body";
}