Changeset 7683

Timestamp:

2004-07-01T13:35:46+12:00 (20 years ago)

Author:

jrm21

Message:

better code for reading in the config file, so not just unix-specific.

File:

• trunk/gsdl/perllib/plugins/DBPlug.pm (modified) (3 diffs)

trunk/gsdl/perllib/plugins/DBPlug.pm

@@ -34 +34 @@
 package DBPlug;
 
+use strict;
+no strict 'refs'; # allow variable as a filehandle
+
 use BasPlug;
 use unicode;
@@ -41 +44 @@
 
 sub BEGIN {
-    @ISA = ('BasPlug');
+    @DBPlug::ISA = ('BasPlug');
 }
 
@@ -138 +141 @@
         return 0;
     }
-    undef $/;       # don't use \n as line separator
-    my $conf = <CONF>;  # reads in whole file
-    $/ = "\n";      # set line separator back
+    my $line;
+    my $statement="";
+    my $callback="";
+    while (defined($line=<CONF>)) {
+    chomp $line;
+    $line =~ s/\s*#.*$//mg; # remove comments
+    $statement .= $line;
+    if ($statement =~ m/;\s*$/) { # ends with ";"
+        # check that it is safe
+        # assignment
+        if ($statement =~ m~\$(\w+)\s* = \s*
+        (\d     # digits
+         | ".*?(?<!\\)" # " up to the next " not preceded by a \
+         | '.*?(?<!\\)' # ' up to the next ' not preceded by a \
+        )\s*;~x) {      # /x means ignore comments and whitespace in rx
+        # evaluate the assignment
+        if (!eval "\$$1=$2;") {
+            my $err=$@;
+            chomp $err;
+            $err =~ s/\.$//; # remove a trailing .
+            print $outhandle "$err (in $filename)\n";
+            return 0; # there was an error reading the config file
+        }
+        } elsif ($callback) {
+        # add this line to the callback function
+        $callback .= $statement;
+        } elsif ($statement =~ /sub text_callback/) {
+        # this is the start of the callback function definition
+        $callback = $statement;
+        }
+        $statement = "";
+    } elsif ($statement =~ /\}\s*$/ && $callback) { # ends with {
+        $callback .= $statement ; $statement = "";
+    }
+    }
     close CONF;
-    eval $conf;     # execute the perl commands in that file
+    if ($callback) {
+    # try to check that the function is "safe"
+    if ($callback =~ /\b(?:system|open|pipe|readpipe|qx|kill|eval|do|use|require|exec|fork)\b/ ||
+        $callback =~ /[\`]|\|\-/) {
+        # no backticks or functions that start new processes allowed
+        print STDERR "DBPlug: bad fuction in callback\n";
+        return 0;
+    }
+    }
 
     if (!defined($db)) {