stump/bin/email-server.pl

   1 #!/usr/bin/perl
   2 ######################################################################
   3 # This perl script is a file server. It allows users
   4 # to retrieve and alter certain files.
   5 # Its purpose is to allow them to manage their installations
   6 # without the need to log in remotely and without the need to know
   7 # anything about Unix(tm).
   8 #
   9 # It only allows retrieving and updating files that have been
  10 # explicitly mentioned as available in its configuration file.
  11 #
  12 # USAGE:
  13 #
  14 # First, you have to come up with a password (I strongly suggest using
  15 # a password that is DIFFERENT from your regular Unix password).
  16 #
  17 # Save it in file $HOME/.email-server.pwd
  18 #
  19 # Second, create a file $HOME/.email-server.cfg and list files (and their
  20 # optional text descriptions) like this:
  21 #
  22 # stump-faq tmp/stump-users-faq.txt FAQ for STUMP users
  23 # rw:mydir some/dir/mydir Directory with test files
  24 #
  25 # The syntax of this file is as follows:
  26 #
  27 # [mode:]filehandle fullpath comment
  28 #
  29 # where mode is either r or rw. r means read only (which is the
  30 # default mode that is used if no mode is mentioned], and rw means that
  31 # the file can be both read and changed.
  32 #
  33 # filehandle is the "external" name by
  34 # which the file will be known to the email user. It may be different from
  35 # the actual file name.
  36 #
  37 # fullpath is the actual path to the file or directory that you want
  38 # to make available, RELATIVE to your home directory.
  39 #
  40 # This script is supposed to be called from your .procmailrc. To recognize
  41 # your requests to this script from other emails, perhaps you could send
  42 # them with a different To: address, for example you could always use
  43 #
  44 #       To: your@email.address (Email File Server)
  45 #
  46 # and then use a procmail recipe like
  47 #
  48 # :0:
  49 # * ^To: .*Email File Server
  50 # | email-server.pl
  51 #
  52 # Copyright(C) 1998 Igor Chudov, ichudov@algebra.com,
  53 #
  54 #                http://www.algebra.com/~ichudov.
  55 #
  56 # GNU Public License applies.
  57 # There is NO WARRANTY WHATSOEVER. USE THIS PROGRAM AT YOUR OWN RISK.
  58 #
  59 ######################################################################
  60
  61 sub read_config {
  62   my $config_file = "$SERVER_ROOT/.email-server.cfg";
  63   open( CONFIG, $config_file )
  64         || die "Config file $config_file not found.";
  65   while( <CONFIG> ) {
  66     chop;
  67     if( ! /^#/ ) {
  68       my ($mode_handle, $file, @explanation) = split;
  69
  70       my $mode = "r", $handle = $mode_handle; # if no mode is present that's
  71                                               # the default
  72
  73       if( $mode_handle =~ /:/ ) {
  74         ($mode, $handle) = split( /:/, $mode_handle );
  75       }
  76
  77       print STDERR "File $file served by email server does not exist in $SERVER_ROOT\n"
  78         if( ! -e "$SERVER_ROOT/$file" );
  79
  80       print STDERR "Mode must be rw or r"
  81         if( $mode ne "r" && $mode ne "rw" );
  82
  83       $served_files{$handle} = $file;
  84       $explanations{$handle} = join( " ", @explanation );
  85       $file_modes{$handle} = $mode;
  86     }
  87   }
  88   close( CONFIG );
  89 }
  90
  91 sub init {
  92
  93   die "HOME is not defined!!!"
  94     if not defined $ENV{'HOME'};
  95
  96   $SERVER_ROOT = $ENV{'HOME'};
  97
  98   &read_config;
  99   open( PASSWORD, "$SERVER_ROOT/.email-server.pwd" );
 100   $password = <PASSWORD>;
 101   chop $password if( $password =~ /\n$/ );
 102   close( PASSWORD );
 103
 104   if( defined $ENV{'EMAIL_SERVER_ADDRESS'} ) {
 105     $email_server_address = $ENV{'EMAIL_SERVER_ADDRESS'};
 106   } else {
 107     $email_server_address = "bad_address\@stump.algebra.com (WRONG ADDRESS)";
 108   }
 109
 110   my @sendmail_dirs = ("/bin", "/usr/bin", "/usr/sbin", "/usr/lib" );
 111
 112   $sendmail = "/bin/mail"; # last resort...
 113
 114   foreach (@sendmail_dirs) {
 115     $sendmail = "$_/sendmail"
 116       if( -x "$_/sendmail" );
 117   }
 118
 119   $short_help = "\nSend email with 'help' in subject field to receive an\n" .
 120                 "explanation on how to work with this email server.\n";
 121   $long_help = "
 122
 123 Hi there,
 124
 125 Thanks for asking for help! Here it is.
 126
 127 I am an automated email server. I am here to help you manage your files
 128 remotely without the need to log in and use Unix commands to edit your
 129 configuration files.
 130
 131 You can retrieve this help message by sending me an email with the only
 132 word 'help' in the Subject: field of your message.
 133
 134 I process your commands. I do a limited set of simple tasks, such as
 135 retrieving and modifying text configuration files. Only certain files
 136 can be retrieved and modified; this is done for your own security.
 137
 138 Whenever you retrieve a file or want to modify a file, you will have
 139 to provide a password to me, as well as the command that I will execute.
 140 Passwords are used to ensure that only authorized users can perform
 141 important operations; however, anyone can request and receive this
 142 help message.
 143
 144 IF YOU DO NOT KNOW THE PASSWORD, you have to ask the
 145 administrator of my account to provide you with one.
 146
 147 All commands, along with passwords, should be specified in the Subject:
 148 field of your messages. A password always goes first, followed by the
 149 command. For example, if your password is 'xyzzy' and the command is
 150 'get moderators' (more on commands later), then the Subject: field
 151 should be
 152
 153         Subject: xyzzy: get moderators
 154
 155 Both commands and passwords are NOT case sensitive. You can mix uppercase
 156 with lowercase as you wish.
 157
 158 COMMANDS:
 159
 160 Right now, there are three kinds of commands:
 161
 162 1. help. This command requests help. Requires no password.
 163
 164 2. get filename. This command requests a file to be sent from the
 165    server to you. The body of your message is ignored.
 166
 167    Example (assuming your password is xyzzy):
 168
 169    Subject: xyzzy: get bad.guys.list
 170
 171    Note that for certain files, their \"names\" may consist of
 172    directory name, followed by a \"/\" (slash) character and the name
 173    of the file. For example, a get command may be of form:
 174
 175    Subject: xyzzy: get messages/offtopic
 176
 177 3. set filename. This command requests that the contents of the file be set
 178    to the text in the body of your message.
 179
 180    Example (assuming your password is xyzzy):
 181
 182    Subject: xyzzy: set bad.guys.list
 183
 184    spammer\@cyberpromo.com
 185    flamer\@netcom.com
 186    <END OF MESSAGE>
 187
 188    Note that for certain files, their \"names\" may consist of
 189    directory name, followed by a \"/\" (slash) character and the name
 190    of the file. For example, a set command may be of form:
 191
 192    Subject: xyzzy: set messages/offtopic
 193
 194    Thanks for submitting your article to comp.sys.foobars.moderated. Your
 195    article is offtopic and is being rejected. Have a nice day!
 196
 197 FILES THAT CAN BE RETRIEVED AND CHANGED.
 198
 199 The following are the file names (that you can mention in set and get
 200 commands) that are supported by this installation:
 201
 202 NAME OF FILE               Explanation
 203
 204 ";
 205
 206   foreach( keys %served_files ) {
 207     $long_help .= $_ . substr( "                    ", length( $_ ), 100 );
 208
 209     my $mode = $file_modes{$_};
 210     if( $mode eq "r" ) { $long_help .= "(Read-Only) "; }
 211     else { $long_help .= "(Read-Write) "; }
 212
 213     $long_help .= $explanations{$_} . "\n";
 214
 215     my $file = "$SERVER_ROOT/$served_files{$_}";
 216
 217     if( ! -e $file ) {
 218       $long_help .= "(this file does NOT exist)\n";
 219     } elsif( -d $file ) {
 220       $long_help .= "$_ is a DIRECTORY. Available files are: \n";
 221       opendir( DIR, $file );
 222       my $dir = $_;
 223       my $fn;
 224       while( $fn = readdir( DIR ) ) {
 225         my $file1 = "$file/$fn";
 226         if( ! /^\./  && -f $file1 && -r $file1 ) {
 227           $long_help .= "\t$dir/$fn\n";
 228         }
 229       }
 230       closedir( DIR );
 231     }
 232   }
 233 }
 234
 235 sub reply {
 236   my $msg = pop( @_ );
 237
 238   my $address = $From;
 239   $address =~ s/^From: //i;
 240
 241   if( defined $ReplyTo ) {
 242     $address = $ReplyTo;
 243     $address =~ s/^Reply-To: //i;
 244     $address =~ s/`//g;
 245     $address =~ s/;//g;
 246   }
 247
 248   open( SENDMAIL, "|$sendmail '$address'" )
 249         || die "Could not start sendmail in $sendmail";
 250
 251   print SENDMAIL "From: $To\n" or die $!;
 252   print SENDMAIL "To: $address\n" or die $!;
 253   print SENDMAIL "Subject: Re: $Subject\n" or die $!;
 254
 255   print SENDMAIL "\n" or die $!;
 256
 257   print SENDMAIL "$msg\n" or die $!;
 258
 259   close( SENDMAIL ) or die "$? $!";
 260
 261 }
 262
 263 sub user_error {
 264   my ($msg) = pop( @_ );
 265   &reply( "You made a mistake:\n\n$msg\n$short_help\n" .
 266           "Message Follows:\n\n$Headers\n$Body\n" );
 267   exit 0;
 268 }
 269
 270 sub readMessage {
 271
 272   while(<STDIN>) {
 273     s/^From />From /;
 274     last if( /^$/ );
 275     $Headers .= $_;
 276     chop;
 277     if( /^Subject: / ) {
 278       $Subject = $_;
 279       $Subject =~ s/^Subject: //;
 280       $Subject = "\L$Subject";
 281     } elsif( /^From: / ) {
 282       $From = $_;
 283       $From =~ s/^From: //;
 284     } elsif( /^To: / ) {
 285       $To = $_;
 286       $To =~ s/^To: //;
 287     } elsif( /^Reply-To: / ) {
 288       $ReplyTo = $_;
 289       $ReplyTo =~ s/^Reply-To: //;
 290     }
 291   }
 292
 293   while( <STDIN> ) {
 294     s/^From />From /;
 295     $Body .= $_;
 296   }
 297 }
 298
 299 sub file_from_arg {
 300   my $arg = pop( @_ );
 301
 302   if( $arg =~ /\// ) {
 303     my ($dir, $file) = split( /\//, $arg );
 304     # now clean $file
 305     $file =~ s/\///g;
 306     $file =~ s/^\.//g;
 307
 308     if( defined $served_files{$dir} ) {
 309       my $fullpath = "$SERVER_ROOT/$served_files{$dir}/$file";
 310       return $fullpath if( -f $fullpath );
 311     }
 312
 313   } else {
 314     if( defined $served_files{$arg} ) {
 315       my $fullpath = "$SERVER_ROOT/$served_files{$arg}";
 316       return $fullpath if( -f $fullpath );
 317     }
 318   }
 319 }
 320
 321 sub mode_from_arg {
 322   my $arg = pop( @_ );
 323   if( $arg =~ /\// ) {
 324     my ($dir, $file) = split( /\//, $arg );
 325     return $file_modes{$dir} if( defined $file_modes{$dir} );
 326   } else {
 327     return $file_modes{$arg};
 328   }
 329 }
 330
 331 sub command_get {
 332   my $arg = pop( @_ );
 333   my $file = &file_from_arg( $arg );
 334
 335   &user_error( "File $arg is not in the list of available files. Perhaps\n" .
 336                "it is a directory or maybe you just misspelled its name." )
 337     if( !$file );
 338
 339   if( -r $file ) {
 340
 341     my $reply_body = "";
 342
 343     open( FILE, $file ) or die $!;
 344     $reply_body .= $_ while( <FILE> );
 345     close( FILE );
 346
 347     &reply( $reply_body );
 348
 349   } else {
 350     &user_error( "File $arg does not exist or is not readable" );
 351   }
 352 }
 353
 354 # sub command_set {
 355 #   my $arg = pop( @_ );
 356 #
 357 #   my $file = &file_from_arg( $arg );
 358 #   my $mode = &mode_from_arg( $arg );
 359 #
 360 #   &user_error( "File $arg is not in the list of available files." )
 361 #     if( !$file );
 362 #
 363 #   if( -w $file && -f $file && $mode eq "rw" ) {
 364 #
 365 #     my $reply_body = "Succeeded in writing to file '$arg':\n\n$Body";
 366 #
 367 #     if( open( FILE, ">$file" ) ) {
 368 #       print FILE $Body;
 369 #       close( FILE );
 370 #     } else {
 371 #       $reply_body = "Failed to write to file $arg:\n\n$Body";
 372 #     }
 373 #
 374 #     &reply( $reply_body );
 375 #
 376 #   } else {
 377 #     &user_error( "File $arg does not exist or is not writable" );
 378 #   }
 379 # }
 380
 381 sub main {
 382   &init;
 383   &readMessage;
 384   &user_error( "No Subject: field provided in your message" ) if( !$Subject );
 385
 386   if( $Subject =~ /^help/ ) {
 387     &reply( $long_help );
 388   } elsif( $Subject =~ /:/ ) {
 389     my ($pass, $command) = split( /:/, $Subject );
 390
 391     &user_error("Invalid Password") if( "\L$pass" ne "\L$password" );
 392
 393     $command =~ s/^ +//;
 394
 395     my @command = split / /, $command;
 396     $command = shift @command;
 397     $command = "\L$command"; # lowercase
 398
 399     my $argument = shift @command;
 400     $argument = "\L$argument";
 401
 402     if( $command eq "get" ) {
 403       &command_get( $argument );
 404     } elsif( $command eq "set" ) {
 405       &command_set( $argument );
 406     } else {
 407       &user_error( "Invalid command: $command" );
 408     }
 409   }
 410 }
 411
 412 ######################################################################
 413 &main;