Parent Directory
| 
Revision Log
Revision 2518 - (view) (download) (as text)
| 1 : | sh002i | 1050 | ################################################################################ |
| 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 the courseWeBWorK.ph file."; | ||
| 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 : | gage | 2518 | 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 : | sh002i | 1050 | |
| 125 : | gage | 2518 | } |
| 126 : | sh002i | 1050 | # 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 : | gage | 2518 | or warn "Failed to create directory at $path"; |
| 147 : | sh002i | 1050 | } |
| 148 : | |||
| 149 : | } | ||
| 150 : | |||
| 151 : | $path = $path . shift(@nodes); #convertPath($path . shift(@nodes)); | ||
| 152 : | #system(qq!echo "" > $path! ); | ||
| 153 : | return $path; | ||
| 154 : | } | ||
| 155 : | |||
| 156 : | 1; |
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |