View of /trunk/pg/macros/IO.pl

    1 ################################################################################
    2 # WeBWorK mod-perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 =head1 NAME
    7 
    8 IO.pl - Temporary location for IO functions that need access to the problem
    9 environment. Formerly defined in IO.pm
   10 
   11 See notes in Translator.pm
   12 
   13 =cut
   14 
   15 sub _IO_init {}
   16 sub _IO_export {
   17   return (
   18     '&send_mail_to',
   19     '&getCourseTempDirectory',
   20     '&surePathToTmpFile',
   21   );
   22 }
   23 
   24 # send_mail_to($user_address,'subject'=>$subject,'body'=>$body)
   25 sub send_mail_to {
   26   my $user_address = shift; # user must be an instructor
   27   my %options = @_;
   28   my $subject = '';
   29   my $msg_body = '';
   30   my @mail_to_allowed_list = ();
   31   my $out;
   32 
   33   my $server = $envir{mailSmtpServer};
   34   my $sender = $envir{mailSmtpSender};
   35 
   36   $subject = $options{'subject'} if defined $options{'subject'};
   37   $msg_body =$options{'body'} if defined $options{'body'};
   38   @mail_to_allowed_list = @{ $options{'ALLOW_MAIL_TO'} }
   39     if defined $options{'ALLOW_MAIL_TO'};
   40 
   41   # check whether user is an instructor
   42   my $mailing_allowed_flag = 0;
   43 
   44   while (@mail_to_allowed_list) {
   45     if ($user_address eq shift @mail_to_allowed_list ) {
   46       $mailing_allowed_flag = 1;
   47       last;
   48     }
   49   }
   50 
   51   if ($mailing_allowed_flag) {
   52     my  $email_msg = "To: $user_address\n"
   53       . "X-Remote-Host: $REMOTE_HOST($REMOTE_ADDR)\n"
   54       . "Subject: $subject\n"
   55       . "\n"
   56       . $msg_body;
   57     my $smtp = Net::SMTP->new($server, Timeout=>10)
   58       or warn "Couldn't contact SMTP server.";
   59     $smtp->mail($sender);
   60 
   61     if ( $smtp->recipient($user_address)) {
   62       # this one's okay, keep going
   63       $smtp->data( $email_msg)
   64         or warn "Unknown problem sending message data to SMTP server.";
   65     } else {
   66       # we have a problem a problem with this address
   67       $smtp->reset;
   68       warn "SMTP server doesn't like this address: <$user_address>.";
   69     }
   70     $smtp->quit;
   71   } else {
   72     die "There has been an error in creating this problem.\n"
   73       . "Please notify your instructor.\n\n"
   74       . "Mail is not permitted to address $user_address.\n"
   75       . "Permitted addresses are specified in global.conf or course.conf.";
   76     $out = 0;
   77   }
   78 
   79   return $out;
   80 }
   81 
   82 sub getCourseTempDirectory {
   83   return $envir{tempDirectory};
   84 }
   85 
   86 =head2 surePathToTmpFile
   87 
   88   surePathToTmpFile($path)
   89   Returns: $path
   90 
   91 Defined in FILE.pl
   92 
   93 Creates all of the subdirectories between the directory specified
   94 by C<&getCourseTempDirectory> and the address of the path.
   95 
   96 Uses
   97 
   98   &createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
   99 
  100 The path may  begin with the correct path to the temporary
  101 directory.  Any other prefix causes a path relative to the temporary
  102 directory to be created.
  103 
  104 The quality of the error checking could be improved. :-)
  105 
  106 =cut
  107 
  108 # A very useful macro for making sure that all of the directories to a file have been constructed.
  109 
  110 sub surePathToTmpFile {
  111   # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
  112   # the input path must be either the full path, or the path relative to this tmp sub directory
  113 
  114   my $path = shift;
  115   my $delim = "/"; #&getDirDelim();
  116   my $tmpDirectory = getCourseTempDirectory();
  117   unless ( -e $tmpDirectory) {   # if by some unlucky chance the tmpDirectory hasn't been created, create it.
  118       my $parentDirectory =  $tmpDirectory;
  119       $parentDirectory =~s|/$||;  # remove a trailing /
  120       $parentDirectory =~s|/\w*$||; # remove last node
  121       my ($perms, $groupID) = (stat $parentDirectory)[2,5];
  122     createDirectory($tmpDirectory, $perms, $groupID)
  123         or warn "Failed to create directory at $path";
  124 
  125   }
  126   # use the permissions/group on the temp directory itself as a template
  127   my ($perms, $groupID) = (stat $tmpDirectory)[2,5];
  128   #warn "&urePathToTmpFile: perms=$perms groupID=$groupID\n";
  129 
  130   # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
  131   $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
  132   #$path = convertPath($path);
  133 
  134   # find the nodes on the given path
  135         my @nodes = split("$delim",$path);
  136 
  137   # create new path
  138   $path = $tmpDirectory; #convertPath("$tmpDirectory");
  139 
  140   while (@nodes>1) {
  141     $path = $path . shift (@nodes) . "/"; #convertPath($path . shift (@nodes) . "/");
  142     unless (-e $path) {
  143       #system("mkdir $path");
  144       #createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
  145       createDirectory($path, $perms, $groupID)
  146         or warn "Failed to create directory at $path";
  147     }
  148 
  149   }
  150 
  151   $path = $path . shift(@nodes); #convertPath($path . shift(@nodes));
  152   #system(qq!echo "" > $path! );
  153   return $path;
  154 }
  155 
  156 1;