package AmphetaDesk::AmphetaDesk; ############################################################################### # AmphetaDesk::AmphetaDesk (c) 2000-2002 Disobey # # morbus@disobey.com http://www.disobey.com/amphetadesk/ # ############################################################################### # ABOUT THIS PACKAGE: # # This the starting point of everything related to AmphetaDesk::AmphetaDesk. The main # # purpose of this script is to act as a traffic cop between the webserver # # and the GUI libraries. It implements a pathetic queuing system, as well # # as sends all the data to the various modules and the web browser. # # # # LIST OF ROUTINES BELOW: # # init - creates the environment and sets up the queue based loop. # ############################################################################### # "moving on down the world. looking for a place." # ############################################################################### use strict; $|++; use CGI qw/:standard :cgi-lib/; use AmphetaDesk::AmphetaDesk::Channels; use AmphetaDesk::AmphetaDesk::ChannelsList; use AmphetaDesk::AmphetaDesk::MyChannels; use AmphetaDesk::AmphetaDesk::Settings; use AmphetaDesk::AmphetaDesk::Templates; use AmphetaDesk::AmphetaDesk::Utilities; use AmphetaDesk::AmphetaDesk::Versioning; use AmphetaDesk::AmphetaDesk::WebServer; use AmphetaDesk::AmphetaDesk::WWW; use File::Spec::Functions; require Exporter; use vars qw( @ISA @EXPORT ); @ISA = qw( Exporter ); @EXPORT = qw( init ); # define a quickie die message on quits. $SIG{INT} = sub { die "User cancelled" } unless $^O =~ /Mac/; # stops Linux/Darwin releases from randomly die'ing. $SIG{PIPE} = 'IGNORE' unless $^O =~ /Mac/; # where are we? ############################################################################### # init - creates the environment and sets up the queue based loop. # ############################################################################### # USAGE: # # init( $wrapper_ver ); # # # # NOTES: # # This routine accepts the version number of the wrapper file that # # calls the init() routine. This allows us some bit of backwards # # compatibility if the wrapper ever changes. # # # # RETURNS: # # n/a; if this routine fails, then Ampheta just ain't gonna work, bub. # ############################################################################### sub init { my ($wrapper_ver) = @_; ############################################################################ # 1.0 Initialization ("wake up, you angst-filled goose!") # # # # Set up everything neccesary for a happy operation, include log files, # # settings, OS determination, GUI starts, version checks, channel updates, # # and webserver binding. Once all this crap is done, start the infiniloop. # ############################################################################ # delete the logfile if it's over 250k, # then reopen it and try to redir STDERR. my $logfile = catfile($ENV{'DIRNAME'}, "AmphetaDesk.log"); if (-e $logfile) { unlink $logfile if -s $logfile > 250000; } open (LOG, ">>$logfile") or die "AmphetaDesk couldn't open the logfile for logging: $!"; open(STDERR,">&LOG") or die "AmphetaDesk couldn't redirect errors to the logfile: $!"; select(LOG); $|++; select(STDOUT); # turn on autoflushing for AmphetaDesk::AmphetaDesk.log. *AmphetaDesk::Utilities::LOG = \*LOG; # map our Utilities::LOG to this LOG filehandle. # load our settings. this routine is located in Settings.pm # and takes care of determining the OS, finding all the paths # to the relevant files, as well as making sure everything exists. load_my_settings( catfile($ENV{'DIRNAME'}, "data", "mySettings.xml") ); # load our os specific libraries. if we don't know, use the Linux # libraries, which currently default to STDOUT for all gui processing. if (get_setting("app_os") =~ /Win/) { require AmphetaDesk::AmphetaDesk::OS::Windows; import AmphetaDesk::AmphetaDesk::OS::Windows; } elsif (get_setting("app_os") =~ /Mac/) { require AmphetaDesk::AmphetaDesk::OS::MacOS; import AmphetaDesk::AmphetaDesk::OS::MacOS; MacPerl::Quit(3); } elsif (get_setting("app_os") =~ /darwin/) { require AmphetaDesk::AmphetaDesk::OS::MacOSX; import AmphetaDesk::AmphetaDesk::OS::MacOSX; } else { require AmphetaDesk::AmphetaDesk::OS::Linux; import AmphetaDesk::AmphetaDesk::OS::Linux; } # start gui. # os specific. &gui_init; # output a little hello. my $joy = ""; if (get_setting("app_os") eq "darwin") { $joy = "OS X? Good choice, my friend."; } my ($app_ver) = get_setting("app_version"); # wow. how sad is *that* easter egg. pffff. note("--------------------------------------------------------------------------------", 1); note("Disobey.com's AmphetaDesk::AmphetaDesk v$app_ver has started (using wrapper v$wrapper_ver).", 1); note( get_setting("app_copyright") . " - " . get_setting("app_url"), 1); note("The operating system is '" . get_setting("app_os") . "'. " . $joy, 0); note("--------------------------------------------------------------------------------", 1); # check for a newer version. # [located in Versioning.pm]. check_version; # load channel subscriptions, clean dead files, and download anything new. note("Downloading the latest channel data. This may take a few minutes.", 1); note("Wait patiently, eh? The latest news will be yours shortly!", 1); note("--------------------------------------------------------------------------------", 1); load_my_channels( get_setting("files_myChannels") ); remove_old_channel_files; download_my_channels; # set our timer variable # for repetitive downloading. my $last_update = time; # start up the webserver(s). # [located in WebServer.pm]. my $daemon = start_webserver; my $radio_daemon = start_radio_webserver if get_setting("user_start_radio_webserver"); # open a browser to # load our index page. open_url(); # os specific note("--------------------------------------------------------------------------------", 1); ############################################################################ # 2.0 Start the Loop ("around and around spun alice.") # # # # Now, we start the listening loop for our webserver. During our loop, we # # listen for specific connections and, if they're valid requests, we pass # # them to our AmphetaDesk::Text::Template module for processing out to the browser. # ############################################################################ # we put the user's "channels_check_interval" into a variable here, so # we don't have get_setting calls every time we go through our infinite loop. my $user_channels_check_interval = get_setting("user_channels_check_interval"); while ( 1 ) { # listen for # a gui event &gui_listen; # if now is later than the user's "channels_check_interval", then # we download all our channels over again. 60 minutes is the minimum. $user_channels_check_interval = 60 if $user_channels_check_interval < 60; if ((time - $last_update) > $user_channels_check_interval * 60) { $last_update = time; download_my_channels; # wHhheeEEE! } # if we receive a connection, suck it in. if we # don't, then we endlessly loop listening for either # webserver or GUI requests until we're closed. we use # one of those funky flipflops to determine if we should # try listening on the $radio_daemon or not (since that # functionality is off by default in our configuration). my $connection = defined($radio_daemon) ? $daemon->accept || $radio_daemon->accept : $daemon->accept; # no connection? move on. next unless defined $connection; # if we're this far, we've got a connection. # get the browser's request from our connection. my $request = $connection->get_request; next unless defined $request; # if this is an invalid URL (something funky with ..'s, or # other characters we're not really fond of), then we send # a cheapo message saying that we don't like them. this # should stop stuff like directory traversals, etc. # note, we ->print and not ->send_error because HTTP::Daemon # doesn't create a valid HTML document, and that's dumb. if ($request->url->path !~ /^[\/A-Za-z0-9\-_\.]+$/ || $request->url->path =~ /\.\./) { $connection->print("\n" . "Forbidden\n" . "

Forbidden

The server understood the request, " . "but is refusing to fulfill it. Please don't try again.\n" . "
AmphetaDesk/" . get_setting("app_version") . " " . "Server at 127.0.0.1 Port " . get_setting("urls_port") . "
"); next; # return to looping. } # if there's a query string, remove the path information for # CGI.pm and then feed it (or the POST in $request->content). my $form_parameters; # this is the final holder of form variables. if ( $request->uri =~ /\?/ ) { $form_parameters = $request->uri; $form_parameters =~ s/[^\?]+\?(.*)/$1/; } else { $form_parameters = $request->content; } $CGI::Q = new CGI($form_parameters); # process our various known form possibilities. these are in order # of preference, and the "unknown_urls" and "del" are deprecated. # individual templates can also use the param() to further react. # add_url and del_url are both located in MyChannels.pm. add_url( param('add_url') || join(",", param('add_urls')) || param('unknown_url') ); del_url( param('del_url') || join(",", param('del_urls')) || param('del') ); # perhaps this is a Radio Userland subscription request? # if so, add the url to our OPML, then redir back to our index. if ($request->url->path =~ /system\/pages\/subscriptions/) { my $home = "http://127.0.0.1:" . get_setting("urls_port") . "/index.html"; add_url( param('url') ); $connection->send_redirect($home); } # if we see a 'reconfigure' variable, then we're to modify # our AmphetaDesk::AmphetaDesk settings, and save out a new copy. we pass # a hash reference to our modify_my_settings, located in Settings.pm. if (param('reconfigure')) { my $hash_ref = Vars; modify_my_settings($hash_ref); } # set the location of our requested filename. if this is a # directory listings ("/"), then rewrite to become "/index.html". my $requested_file = $request->url->path; $requested_file =~ s/^\///; if ( get_setting("app_os") =~ /Mac/ ) { $requested_file =~ s/\//:/g; } my $filename = catfile( get_setting("dir_templates"), $requested_file ); if ($filename =~ /[\/\\:]$/) { $filename .= "index.html"; } # now, we start serving the files. if this is an image and # it exists, then we binmode it for Windows, and send it out. if ( ( $filename =~ /(jpg|gif|png)$/ ) and -e $filename ) { open(IMG, $filename) or note("Oof! AmphetaDesk::AmphetaDesk could not open $filename. " . "Please report the following error to " . get_setting("app_email") . ": $!", 1); # print out the http headers. my $type = "image/$1"; $connection->send_basic_header(); $connection->print("Content-type: $type\015\012"); $connection->print("\015\012"); # no more headers. # and now the image. binmode $connection; binmode IMG; $connection->print($_) while ; close(IMG); } # if the filename exists, pass it # through AmphetaDesk::AmphetaDesk::Templates. elsif (-e $filename) { # print out the http headers. $connection->send_basic_header(); $connection->print("Content-Type: text/html\015\012"); $connection->print("\015\012"); # no more headers. # fill it in, and then send it out. fun, fun. # parse_template is located in AmphetaDesk::AmphetaDesk::Templates. $connection->print( parse_template($filename) ); } # no clue, so write out an "apache rulezzzzz" error page. # note, we ->print and not ->send_error because HTTP::Daemon # doesn't create a valid HTML document, nor could we get # it to listen to our customized error message. we also don't # ->send_basic_header(404, "Not Found") for a similar reason: # we want to customize our error message, and any $msg we # throw becomes part of the response code, which is bad. else { # yeah. i love apache. more than you. or my burning ears. $connection->send_basic_header(); $connection->print("Content-type: text/html\015\012"); $connection->print("\015\012"); # no more headers. $connection->print("\n" . "Not Found\n" . "

Not Found

The requested URL $requested_file was not found." . "
AmphetaDesk/" . get_setting("app_version") . " " . "Server at 127.0.0.1 Port " . get_setting("urls_port") . "
\n"); } # all done with this request. $connection->close; } ############################################################################ # 3.0 The End ("the book closed silently. it was not done.") # # # # If we're here, then close out the program cos we've been banished rather # # rudely from memory. We'll be waiting though. We'll show you. Muhahah. # # Shut down our open file and pipe handles, and then exit miserably. # ############################################################################ END { save_my_channels; save_my_settings; close LOG; $daemon->shutdown(2) if $daemon; } exit; } 1;