[system] / trunk / xmlrpc / daemon / IOglue.pl Repository:
ViewVC logotype

View of /trunk/xmlrpc/daemon/IOglue.pl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 279 - (download) (as text) (annotate)
Fri May 17 21:44:04 2002 UTC (17 years, 3 months ago) by gage
File size: 9133 byte(s)
Experimental xmlrpc WeBWorK webservices

    1 #!/usr/bin/perl  -w
    2 
    3 use strict;
    4 
    5 =head2   Private functions (not methods) used by PGtranslator for file IO.
    6 
    7 
    8 
    9 =cut
   10 
   11 my $REMOTE_HOST = (defined( $ENV{'REMOTE_HOST'} ) ) ? $ENV{'REMOTE_HOST'}: 'unknown host';
   12 my $REMOTE_ADDR = (defined( $ENV{'REMOTE_ADDR'}) ) ? $ENV{'REMOTE_ADDR'}: 'unknown address';
   13 
   14 
   15 =head2 includePGtext
   16 
   17   includePGtext($string_ref, $envir_ref)
   18 
   19 Calls C<createPGtext> recursively with the $safeCompartment variable set to 0
   20 so that the rendering continues in the current safe compartment.  The output
   21 is the same as the output from createPGtext. This is used in processing
   22 some of the sample CAPA files.
   23 
   24 =cut
   25 
   26 
   27 sub includePGtext  {
   28     my $evalString = shift;
   29     if (ref($evalString) eq 'SCALAR') {
   30       $evalString = $$evalString;
   31     }
   32     $evalString =~ s/\nBEGIN_TEXT/TEXT\(EV3\(<<'END_TEXT'\)\);/g;
   33     $evalString =~ s/\\/\\\\/g;    # \ can't be used for escapes because of TeX conflict
   34     $evalString =~ s/~~/\\/g;      # use ~~ as escape instead, use # for comments
   35     no strict;
   36       eval("package main; $evalString") ;
   37       my $errors = $@;
   38       die eval(q! "ERROR in included file:\n$main::envir{probFileName}\n $errors\n"!) if $errors;
   39     use strict;
   40         '';
   41 }
   42 
   43 
   44 
   45 =head2 send_mail_to
   46 
   47   send_mail_to($user_address,'subject'=>$subject,'body'=>$body)
   48 
   49   Returns: 1 if the address is ok, otherwise a fatal error is signaled using wwerror.
   50 
   51 Sends $body to the address specified by $user_address provided that
   52 the address appears in C<@{$Global::PG_environment{'ALLOW_MAIL_TO'}}>.
   53 
   54 This subroutine is likely to be fragile and to require tweaking when installed
   55 in a new environment.  It uses the unix application C<sendmail>.
   56 
   57 =cut
   58 
   59 
   60 sub send_mail_to {
   61     my $user_address = shift;   # user must be an instructor
   62     my %options = @_;
   63     my $subject = '';
   64        $subject = $options{'subject'} if defined($options{'subject'});
   65     my $msg_body = '';
   66        $msg_body =$options{'body'} if defined($options{'body'});
   67     my @mail_to_allowed_list = ();
   68        @mail_to_allowed_list = @{ $options{'ALLOW_MAIL_TO'} } if defined($options{'ALLOW_MAIL_TO'});
   69     my $out;
   70 
   71     # check whether user is an instructor
   72     my $mailing_allowed_flag =0;
   73 
   74 
   75      while (@mail_to_allowed_list) {
   76       if ($user_address eq shift @mail_to_allowed_list ) {
   77         $mailing_allowed_flag =1;
   78         last;
   79       }
   80      }
   81     if ($mailing_allowed_flag) {
   82     ## mail header text:
   83     my   $email_msg ="To:  $user_address\n" .
   84         "X-Remote-Host:  $REMOTE_HOST($REMOTE_ADDR)\n" .
   85         "Subject: $subject\n\n" . $msg_body;
   86       my $smtp = Net::SMTP->new($Global::smtpServer, Timeout=>10) ||
   87       warn "Couldn't contact SMTP server.";
   88       $smtp->mail($Global::webmaster);
   89 
   90     if ( $smtp->recipient($user_address)) {  # this one's okay, keep going
   91           $smtp->data( $email_msg) ||
   92         warn("Unknown problem sending message data to SMTP server.");
   93       } else {      # we have a problem a problem with this address
   94         $smtp->reset;
   95           warn "SMTP server doesn't like this address: <$user_address>.";
   96     }
   97       $smtp->quit;
   98 
   99     } else {
  100 
  101     Global::wwerror("$0","There has been an error in creating this problem.\n" .
  102                  "Please notify your instructor.\n\n" .
  103                  "Mail is not permitted to address $user_address.\n" .
  104                  "Permitted addresses are specified in the courseWeBWorK.ph file.",
  105                  "","","");
  106      $out = 0;
  107     }
  108 
  109     $out;
  110 
  111 }
  112 # only files are loaded first from the macroDirectory and then from the courseScriptsDirectory
  113 # files cannot be loaded from other directories.
  114 
  115 
  116 
  117 
  118 #
  119 # # these have been copied over from FILE.pl.  I don't know if they need to be duplicated or not.
  120 # ## these call backs come from PGchoice -- mostly from within the alias command.
  121 #
  122 
  123 =head2   read_whole_problem_file
  124 
  125   read_whole_problem_file($filePath);
  126 
  127   Returns: A reference to a string containing
  128            the contents of the file.
  129 
  130 Don't use for huge files. The file name will have .pg appended to it if it doesn't
  131 already end in .pg.  Files may become double spaced.?  Check the join below. This is
  132 used in importing additional .pg files as is done in the
  133 sample problems translated from CAPA.
  134 
  135 =cut
  136 
  137 
  138 sub read_whole_problem_file {
  139   my $filePath = shift;
  140     $filePath =~s/^\s*//; # get rid of initial spaces
  141   $filePath =~s/\s*$//; # get rid of final spaces
  142   $filePath = "$filePath.pg" unless $filePath =~ /\.pg$/;
  143     read_whole_file($filePath);
  144 }
  145 
  146 sub read_whole_file {
  147   my $filePath = shift;
  148     local (*INPUT);
  149   open(INPUT, "<$filePath")|| die "$0: readWholeProblemFile subroutine: <BR>Can't read file $filePath";
  150   local($/)=undef;
  151   my $string = <INPUT>;  # can't append spaces because this causes trouble with <<'EOF'   \nEOF construction
  152   close(INPUT);
  153   \$string;
  154 }
  155 
  156 
  157 =head2 convertPath
  158 
  159   $path = convertPath($path);
  160 
  161 Normalizes the delimiters in the path using delimiter from C<&getDirDelim()>
  162 which is defined in C<Global.pm>.
  163 
  164 =cut
  165 
  166 ## converts full path names to to use the $dirDelim instead of /
  167 
  168 sub convertPath {
  169     &Global::convertPath;
  170 }
  171 
  172 # hacks to make this program work independent of Global.pm
  173 sub getDirDelim {
  174   return ("/");
  175 }
  176 sub getCourseTempDirectory {
  177   return ($Global::courseTempDirectory);
  178 }
  179 
  180 =head2 surePathToTmpFile
  181 
  182   surePathToTmpFile($path)
  183   Returns: $path
  184 
  185 Defined in FILE.pl
  186 
  187 Creates all of the subdirectories between the directory specified
  188 by C<&getCourseTempDirectory> and the address of the path.
  189 
  190 Uses
  191 
  192   &createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID)
  193 
  194 The path may  begin with the correct path to the temporary
  195 directory.  Any other prefix causes a path relative to the temporary
  196 directory to be created.
  197 
  198 The quality of the error checking could be improved. :-)
  199 
  200 =cut
  201 
  202 # A very useful macro for making sure that all of the directories to a file have been constructed.
  203 
  204 sub surePathToTmpFile {  # constructs intermediate directories if needed beginning at ${Global::htmlDirectory}tmp/
  205                # the input path must be either the full path, or the path relative to this tmp sub directory
  206          my $path      = shift;
  207          my $delim    = &getDirDelim();
  208          my $tmpDirectory = getCourseTempDirectory();
  209     # if the path starts with $tmpDirectory (which is permitted but optional) remove this initial segment
  210         $path =~ s|^$tmpDirectory|| if $path =~ m|^$tmpDirectory|;
  211         $path = convertPath($path);
  212     # find the nodes on the given path
  213         my @nodes     = split("$delim",$path);
  214     # create new path
  215         $path   = convertPath("$tmpDirectory");
  216 
  217         while (@nodes>1 ) {
  218             $path = convertPath($path . shift (@nodes) ."/");
  219             unless (-e $path) {
  220             #   system("mkdir $path");
  221                 createDirectory($path,$Global::tmp_directory_permission, $Global::numericalGroupID) ||
  222                 Global::wwerror($0, "Failed to create directory $path","","","");
  223 
  224             }
  225 
  226         }
  227         $path = convertPath($path . shift(@nodes));
  228 
  229        # system(qq!echo "" > $path! );
  230 
  231 $path;
  232 
  233 }
  234 
  235 
  236 =head2 fileFromPath
  237 
  238   $fileName = fileFromPath($path)
  239 
  240 Defined in C<FILE.pl>.
  241 
  242 Uses C<&getDirDelim()> to determine the path delimiter.  Returns the last segment
  243 of the path (after the last delimiter.)
  244 
  245 =cut
  246 
  247 sub fileFromPath {
  248         my $path = shift;
  249         my $delim =&getDirDelim();
  250         $path =  convertPath($path);
  251         $path =~  m|([^$delim]+)$|;
  252         $1;
  253 
  254 }
  255 
  256 =head2 directoryFromPath
  257 
  258 
  259   $directoryPath = directoryFromPath($path)
  260 
  261 Defined in C<FILE.pl>.
  262 
  263 Uses C<&getDirDelim()> to determine the path delimiter.  Returns the initial segments
  264 of the of the path (up to the last delimiter.)
  265 
  266 =cut
  267 
  268 sub directoryFromPath {
  269         my $path = shift;
  270         my $delim =&getDirDelim();
  271         $path = convertPath($path);
  272         $path =~ s|[^$delim]*$||;
  273     $path;
  274 }
  275 
  276 =head2 createFile
  277 
  278   createFile($filePath);
  279 
  280 Calls C<FILE.pl> version of createFile with
  281 C<createFile($filePath,0660(permission),$Global::numericalGroupID)>
  282 
  283 =cut
  284 
  285 sub createFile {
  286     my ($fileName, $permission, $numgid) = @_;
  287     open(TEMPCREATEFILE, ">$fileName") ||
  288       Global::wwerror("File.pl: createFile error", " Can't open $fileName");
  289     my @stat = stat TEMPCREATEFILE;
  290     close(TEMPCREATEFILE);
  291 
  292     ## if the owner of the file is running this script (e.g. when the file is first created)
  293     ## set the permissions and group correctly
  294     if ($< == $stat[4]) {
  295         my $tmp = chmod($permission,$fileName) or
  296           warn("File.pl: createFile error", " Can't do chmod($permission, $fileName)");
  297         chown(-1,$numgid,$fileName)  or
  298           warn("File.pl: createFile error", " Can't do chown($numgid, $fileName)");
  299     }
  300 }
  301 
  302 sub createDirectory
  303     {
  304     my ($dirName, $permission, $numgid) = @_;
  305     mkdir($dirName, $permission) or
  306       warn("$0: createDirectory error", " Can't do mkdir($dirName, $permission)");
  307     chmod($permission, $dirName) or
  308       warn("$0: createDirectory error", " Can't do chmod($permission, $dirName)");
  309     unless ($numgid == -1) {chown(-1,$numgid,$dirName) or
  310       warn("$0: createDirectory error", " Can't do chown(-1,$numgid,$dirName)");}
  311 }
  312 
  313 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9