1package AmphetaDesk::AmphetaDesk; 2############################################################################### 3# AmphetaDesk::AmphetaDesk (c) 2000-2002 Disobey # 4# morbus@disobey.com http://www.disobey.com/amphetadesk/ # 5############################################################################### 6# ABOUT THIS PACKAGE: # 7# This the starting point of everything related to AmphetaDesk::AmphetaDesk. The main # 8# purpose of this script is to act as a traffic cop between the webserver # 9# and the GUI libraries. It implements a pathetic queuing system, as well # 10# as sends all the data to the various modules and the web browser. # 11# # 12# LIST OF ROUTINES BELOW: # 13# init - creates the environment and sets up the queue based loop. # 14############################################################################### 15# "moving on down the world. looking for a place." # 16############################################################################### 17 18use strict; $|++; 19use CGI qw/:standard :cgi-lib/; 20use AmphetaDesk::AmphetaDesk::Channels; 21use AmphetaDesk::AmphetaDesk::ChannelsList; 22use AmphetaDesk::AmphetaDesk::MyChannels; 23use AmphetaDesk::AmphetaDesk::Settings; 24use AmphetaDesk::AmphetaDesk::Templates; 25use AmphetaDesk::AmphetaDesk::Utilities; 26use AmphetaDesk::AmphetaDesk::Versioning; 27use AmphetaDesk::AmphetaDesk::WebServer; 28use AmphetaDesk::AmphetaDesk::WWW; 29use File::Spec::Functions; 30require Exporter; 31use vars qw( @ISA @EXPORT ); 32@ISA = qw( Exporter ); 33@EXPORT = qw( init ); 34 35# define a quickie die message on quits. 36$SIG{INT} = sub { die "User cancelled" } unless $^O =~ /Mac/; 37 38# stops Linux/Darwin releases from randomly die'ing. 39$SIG{PIPE} = 'IGNORE' unless $^O =~ /Mac/; 40 41# where are we? 42 43 44############################################################################### 45# init - creates the environment and sets up the queue based loop. # 46############################################################################### 47# USAGE: # 48# init( $wrapper_ver ); # 49# # 50# NOTES: # 51# This routine accepts the version number of the wrapper file that # 52# calls the init() routine. This allows us some bit of backwards # 53# compatibility if the wrapper ever changes. # 54# # 55# RETURNS: # 56# n/a; if this routine fails, then Ampheta just ain't gonna work, bub. # 57############################################################################### 58 59sub init { 60 61 my ($wrapper_ver) = @_; 62 63 ############################################################################ 64 # 1.0 Initialization ("wake up, you angst-filled goose!") # 65 # # 66 # Set up everything neccesary for a happy operation, include log files, # 67 # settings, OS determination, GUI starts, version checks, channel updates, # 68 # and webserver binding. Once all this crap is done, start the infiniloop. # 69 ############################################################################ 70 71 # delete the logfile if it's over 250k, 72 # then reopen it and try to redir STDERR. 73 my $logfile = catfile($ENV{'DIRNAME'}, "AmphetaDesk.log"); 74 if (-e $logfile) { unlink $logfile if -s $logfile > 250000; } 75 open (LOG, ">>$logfile") or die "AmphetaDesk couldn't open the logfile for logging: $!"; 76 open(STDERR,">&LOG") or die "AmphetaDesk couldn't redirect errors to the logfile: $!"; 77 select(LOG); $|++; select(STDOUT); # turn on autoflushing for AmphetaDesk::AmphetaDesk.log. 78 *AmphetaDesk::Utilities::LOG = \*LOG; # map our Utilities::LOG to this LOG filehandle. 79 80 # load our settings. this routine is located in Settings.pm 81 # and takes care of determining the OS, finding all the paths 82 # to the relevant files, as well as making sure everything exists. 83 load_my_settings( catfile($ENV{'DIRNAME'}, "data", "mySettings.xml") ); 84 85 # load our os specific libraries. if we don't know, use the Linux 86 # libraries, which currently default to STDOUT for all gui processing. 87 if (get_setting("app_os") =~ /Win/) { require AmphetaDesk::AmphetaDesk::OS::Windows; import AmphetaDesk::AmphetaDesk::OS::Windows; } 88 elsif (get_setting("app_os") =~ /Mac/) { require AmphetaDesk::AmphetaDesk::OS::MacOS; import AmphetaDesk::AmphetaDesk::OS::MacOS; MacPerl::Quit(3); } 89 elsif (get_setting("app_os") =~ /darwin/) { require AmphetaDesk::AmphetaDesk::OS::MacOSX; import AmphetaDesk::AmphetaDesk::OS::MacOSX; } 90 else { require AmphetaDesk::AmphetaDesk::OS::Linux; import AmphetaDesk::AmphetaDesk::OS::Linux; } 91 92 # start gui. 93 # os specific. 94 &gui_init; 95 96 # output a little hello. 97 my $joy = ""; if (get_setting("app_os") eq "darwin") { $joy = "OS X? Good choice, my friend."; } 98 my ($app_ver) = get_setting("app_version"); # wow. how sad is *that* easter egg. pffff. 99 note("--------------------------------------------------------------------------------", 1); 100 note("Disobey.com's AmphetaDesk::AmphetaDesk v$app_ver has started (using wrapper v$wrapper_ver).", 1); 101 note( get_setting("app_copyright") . " - " . get_setting("app_url"), 1); 102 note("The operating system is '" . get_setting("app_os") . "'. " . $joy, 0); 103 note("--------------------------------------------------------------------------------", 1); 104 105 # check for a newer version. 106 # [located in Versioning.pm]. 107 check_version; 108 109 # load channel subscriptions, clean dead files, and download anything new. 110 note("Downloading the latest channel data. This may take a few minutes.", 1); 111 note("Wait patiently, eh? The latest news will be yours shortly!", 1); 112 note("--------------------------------------------------------------------------------", 1); 113 load_my_channels( get_setting("files_myChannels") ); 114 remove_old_channel_files; download_my_channels; 115 116 # set our timer variable 117 # for repetitive downloading. 118 my $last_update = time; 119 120 # start up the webserver(s). 121 # [located in WebServer.pm]. 122 my $daemon = start_webserver; 123 my $radio_daemon = start_radio_webserver if get_setting("user_start_radio_webserver"); 124 125 # open a browser to 126 # load our index page. 127 open_url(); # os specific 128 note("--------------------------------------------------------------------------------", 1); 129 130 ############################################################################ 131 # 2.0 Start the Loop ("around and around spun alice.") # 132 # # 133 # Now, we start the listening loop for our webserver. During our loop, we # 134 # listen for specific connections and, if they're valid requests, we pass # 135 # them to our AmphetaDesk::Text::Template module for processing out to the browser. # 136 ############################################################################ 137 138 # we put the user's "channels_check_interval" into a variable here, so 139 # we don't have get_setting calls every time we go through our infinite loop. 140 my $user_channels_check_interval = get_setting("user_channels_check_interval"); 141 142 while ( 1 ) { 143 144 # listen for 145 # a gui event 146 &gui_listen; 147 148 # if now is later than the user's "channels_check_interval", then 149 # we download all our channels over again. 60 minutes is the minimum. 150 $user_channels_check_interval = 60 if $user_channels_check_interval < 60; 151 if ((time - $last_update) > $user_channels_check_interval * 60) { 152 $last_update = time; download_my_channels; # wHhheeEEE! 153 } 154 155 # if we receive a connection, suck it in. if we 156 # don't, then we endlessly loop listening for either 157 # webserver or GUI requests until we're closed. we use 158 # one of those funky flipflops to determine if we should 159 # try listening on the $radio_daemon or not (since that 160 # functionality is off by default in our configuration). 161 my $connection = defined($radio_daemon) ? $daemon->accept || $radio_daemon->accept : $daemon->accept; 162 163 # no connection? move on. 164 next unless defined $connection; 165 166 # if we're this far, we've got a connection. 167 # get the browser's request from our connection. 168 my $request = $connection->get_request; next unless defined $request; 169 170 # if this is an invalid URL (something funky with ..'s, or 171 # other characters we're not really fond of), then we send 172 # a cheapo message saying that we don't like them. this 173 # should stop stuff like directory traversals, etc. 174 # note, we ->print and not ->send_error because HTTP::Daemon 175 # doesn't create a valid HTML document, and that's dumb. 176 if ($request->url->path !~ /^[\/A-Za-z0-9\-_\.]+$/ || $request->url->path =~ /\.\./) { 177 $connection->print("<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n" . 178 "<html><head><title>Forbidden</title></head><body>\n" . 179 "<h1>Forbidden</h1> The server understood the request, " . 180 "but is refusing to fulfill it. Please don't try again.\n" . 181 "<hr><address>AmphetaDesk/" . get_setting("app_version") . " " . 182 "Server at 127.0.0.1 Port " . get_setting("urls_port") . 183 "</address></body></html>"); 184 next; # return to looping. 185 } 186 187 # if there's a query string, remove the path information for 188 # CGI.pm and then feed it (or the POST in $request->content). 189 my $form_parameters; # this is the final holder of form variables. 190 if ( $request->uri =~ /\?/ ) { 191 $form_parameters = $request->uri; 192 $form_parameters =~ s/[^\?]+\?(.*)/$1/; 193 } else { $form_parameters = $request->content; } 194 $CGI::Q = new CGI($form_parameters); 195 196 # process our various known form possibilities. these are in order 197 # of preference, and the "unknown_urls" and "del" are deprecated. 198 # individual templates can also use the param() to further react. 199 # add_url and del_url are both located in MyChannels.pm. 200 add_url( param('add_url') || join(",", param('add_urls')) || param('unknown_url') ); 201 del_url( param('del_url') || join(",", param('del_urls')) || param('del') ); 202 203 # perhaps this is a Radio Userland subscription request? 204 # if so, add the url to our OPML, then redir back to our index. 205 if ($request->url->path =~ /system\/pages\/subscriptions/) { 206 my $home = "http://127.0.0.1:" . get_setting("urls_port") . "/index.html"; 207 add_url( param('url') ); $connection->send_redirect($home); 208 } 209 210 # if we see a 'reconfigure' variable, then we're to modify 211 # our AmphetaDesk::AmphetaDesk settings, and save out a new copy. we pass 212 # a hash reference to our modify_my_settings, located in Settings.pm. 213 if (param('reconfigure')) { my $hash_ref = Vars; modify_my_settings($hash_ref); } 214 215 # set the location of our requested filename. if this is a 216 # directory listings ("/"), then rewrite to become "/index.html". 217 my $requested_file = $request->url->path; $requested_file =~ s/^\///; 218 if ( get_setting("app_os") =~ /Mac/ ) { $requested_file =~ s/\//:/g; } 219 my $filename = catfile( get_setting("dir_templates"), $requested_file ); 220 if ($filename =~ /[\/\\:]$/) { $filename .= "index.html"; } 221 222 # now, we start serving the files. if this is an image and 223 # it exists, then we binmode it for Windows, and send it out. 224 if ( ( $filename =~ /(jpg|gif|png)$/ ) and -e $filename ) { 225 open(IMG, $filename) or note("Oof! AmphetaDesk::AmphetaDesk could not open $filename. " . 226 "Please report the following error to " . 227 get_setting("app_email") . ": $!", 1); 228 229 # print out the http headers. 230 my $type = "image/$1"; 231 $connection->send_basic_header(); 232 $connection->print("Content-type: $type\015\012"); 233 $connection->print("\015\012"); # no more headers. 234 235 # and now the image. 236 binmode $connection; binmode IMG; 237 $connection->print($_) while <IMG>; close(IMG); 238 } 239 240 # if the filename exists, pass it 241 # through AmphetaDesk::AmphetaDesk::Templates. 242 elsif (-e $filename) { 243 244 # print out the http headers. 245 $connection->send_basic_header(); 246 $connection->print("Content-Type: text/html\015\012"); 247 $connection->print("\015\012"); # no more headers. 248 249 # fill it in, and then send it out. fun, fun. 250 # parse_template is located in AmphetaDesk::AmphetaDesk::Templates. 251 $connection->print( parse_template($filename) ); 252 } 253 254 # no clue, so write out an "apache rulezzzzz" error page. 255 # note, we ->print and not ->send_error because HTTP::Daemon 256 # doesn't create a valid HTML document, nor could we get 257 # it to listen to our customized error message. we also don't 258 # ->send_basic_header(404, "Not Found") for a similar reason: 259 # we want to customize our error message, and any $msg we 260 # throw becomes part of the response code, which is bad. 261 else { # yeah. i love apache. more than you. or my burning ears. 262 $connection->send_basic_header(); 263 $connection->print("Content-type: text/html\015\012"); 264 $connection->print("\015\012"); # no more headers. 265 $connection->print("<!DOCTYPE HTML PUBLIC \"-//IETF//DTD HTML 2.0//EN\">\n" . 266 "<html><head><title>Not Found</title></head><body>\n" . 267 "<h1>Not Found</h1> The requested URL $requested_file was not found." . 268 "<hr><address>AmphetaDesk/" . get_setting("app_version") . " " . 269 "Server at 127.0.0.1 Port " . get_setting("urls_port") . 270 "</address></body></html>\n"); 271 } 272 273 # all done with this request. 274 $connection->close; 275 } 276 277 ############################################################################ 278 # 3.0 The End ("the book closed silently. it was not done.") # 279 # # 280 # If we're here, then close out the program cos we've been banished rather # 281 # rudely from memory. We'll be waiting though. We'll show you. Muhahah. # 282 # Shut down our open file and pipe handles, and then exit miserably. # 283 ############################################################################ 284 285 END { 286 save_my_channels; save_my_settings; 287 close LOG; $daemon->shutdown(2) if $daemon; 288 } exit; 289 290} 291 2921;