| 1 | #!/usr/bin/perl -w
|
|---|
| 2 |
|
|---|
| 3 | use CGI;
|
|---|
| 4 | use usabcgi;
|
|---|
| 5 |
|
|---|
| 6 | sub init_cgi
|
|---|
| 7 | {
|
|---|
| 8 | my $line = <STDIN>;
|
|---|
| 9 | my $cgi;
|
|---|
| 10 |
|
|---|
| 11 | if ((defined $line) && ($line ne "")) {
|
|---|
| 12 | $cgi = new CGI($line);
|
|---|
| 13 | }
|
|---|
| 14 | else {
|
|---|
| 15 | $cgi = new CGI();
|
|---|
| 16 | }
|
|---|
| 17 |
|
|---|
| 18 | return $cgi;
|
|---|
| 19 | }
|
|---|
| 20 |
|
|---|
| 21 | sub clean_param
|
|---|
| 22 | {
|
|---|
| 23 | my ($cgi,$param) = @_;
|
|---|
| 24 |
|
|---|
| 25 | my $val = $cgi->param($param);
|
|---|
| 26 | $val =~ s/[\r\n]+$// if (defined $val);
|
|---|
| 27 |
|
|---|
| 28 | return $val;
|
|---|
| 29 | }
|
|---|
| 30 |
|
|---|
| 31 | sub safe_val
|
|---|
| 32 | {
|
|---|
| 33 | my ($val) = @_;
|
|---|
| 34 |
|
|---|
| 35 | # ensure only alpha-numeric plus a few other special chars
|
|---|
| 36 |
|
|---|
| 37 | $val =~ s/[^[:alnum:]@\.\/\-]//g if (defined $val);
|
|---|
| 38 |
|
|---|
| 39 | return $val;
|
|---|
| 40 | }
|
|---|
| 41 |
|
|---|
| 42 | sub run_gencmd
|
|---|
| 43 | {
|
|---|
| 44 | my ($prog,$col,$cgi) = @_;
|
|---|
| 45 |
|
|---|
| 46 | my @arg_keys = $cgi->param;
|
|---|
| 47 |
|
|---|
| 48 | my $cmd = "source setup.bash > /dev/null ; $prog.pl ";
|
|---|
| 49 |
|
|---|
| 50 | foreach my $k ( @arg_keys ) {
|
|---|
| 51 | my $arg_val = clean_param($cgi,$k);
|
|---|
| 52 | # ensure only alphanumeric, plus a few special chars
|
|---|
| 53 | $arg_val = safe_val($arg_val);
|
|---|
| 54 | $cmd .= " -$k $arg_val"
|
|---|
| 55 | }
|
|---|
| 56 |
|
|---|
| 57 | $cmd .= " $col" if (defined $col);
|
|---|
| 58 |
|
|---|
| 59 | my $status;
|
|---|
| 60 |
|
|---|
| 61 | if (open(PIN,"$cmd 2>&1 |")) {
|
|---|
| 62 | while (defined (my $line=<PIN>)) {
|
|---|
| 63 | print STDOUT $line;
|
|---|
| 64 | }
|
|---|
| 65 | close(PIN);
|
|---|
| 66 |
|
|---|
| 67 | $status = $?;
|
|---|
| 68 |
|
|---|
| 69 | # print STDOUT "Exit status: $status\n";
|
|---|
| 70 | }
|
|---|
| 71 | else {
|
|---|
| 72 | print STDOUT "Error: unable to execute cmd: $cmd\n";
|
|---|
| 73 | $status = -1;
|
|---|
| 74 | }
|
|---|
| 75 |
|
|---|
| 76 | return $status;
|
|---|
| 77 | }
|
|---|
| 78 |
|
|---|
| 79 |
|
|---|
| 80 | sub run_buildcol
|
|---|
| 81 | {
|
|---|
| 82 | my ($col,$cgi) = @_;
|
|---|
| 83 |
|
|---|
| 84 | if (defined $col) {
|
|---|
| 85 | chdir("collect/$col");
|
|---|
| 86 | `rm -rf building/*; `;
|
|---|
| 87 | chdir("../..");
|
|---|
| 88 | }
|
|---|
| 89 |
|
|---|
| 90 | my $status = run_gencmd("buildcol",$col,$cgi);
|
|---|
| 91 |
|
|---|
| 92 | if ($status == 0) {
|
|---|
| 93 | if (defined $col) {
|
|---|
| 94 | chdir("collect/$col");
|
|---|
| 95 | `rm -rf index/*; cp -r building/. index/.`;
|
|---|
| 96 | chdir("../..");
|
|---|
| 97 | }
|
|---|
| 98 | }
|
|---|
| 99 | else {
|
|---|
| 100 |
|
|---|
| 101 | # An error has occured
|
|---|
| 102 | }
|
|---|
| 103 | }
|
|---|
| 104 |
|
|---|
| 105 |
|
|---|
| 106 | sub run_deldir
|
|---|
| 107 | {
|
|---|
| 108 | my ($col,$cgi) = @_;
|
|---|
| 109 |
|
|---|
| 110 | chdir("collect");
|
|---|
| 111 |
|
|---|
| 112 | my $dir = clean_param($cgi,"dir");
|
|---|
| 113 | $dir = "" if ($dir eq ".");
|
|---|
| 114 |
|
|---|
| 115 | my $cmd = "/bin/rm -rf $col/$dir";
|
|---|
| 116 |
|
|---|
| 117 | my $output = `$cmd`;
|
|---|
| 118 |
|
|---|
| 119 | chdir("..");
|
|---|
| 120 | }
|
|---|
| 121 |
|
|---|
| 122 | sub main
|
|---|
| 123 | {
|
|---|
| 124 | print "Content-type:text/plain\n\n";
|
|---|
| 125 |
|
|---|
| 126 | my $cgi = init_cgi();
|
|---|
| 127 |
|
|---|
| 128 | my ($gsdlhome) = usabcgi::get_config_info("gsdlhome");
|
|---|
| 129 | chdir($gsdlhome);
|
|---|
| 130 |
|
|---|
| 131 | my $cmd = clean_param($cgi,"cmd");
|
|---|
| 132 | $cgi->delete("cmd");
|
|---|
| 133 | $cmd =~ s/\..*$//;
|
|---|
| 134 | $cmd = safe_val($cmd);
|
|---|
| 135 |
|
|---|
| 136 | my $col = clean_param($cgi,"c");
|
|---|
| 137 | if ((!defined $col) || ($col =~ m/^\s*$/)) {
|
|---|
| 138 | print "Content-type:text/plain\n\n";
|
|---|
| 139 | print "Error: No collection name specified\n";
|
|---|
| 140 | exit;
|
|---|
| 141 | }
|
|---|
| 142 |
|
|---|
| 143 | $cgi->delete("c");
|
|---|
| 144 | $col = safe_val($col);
|
|---|
| 145 |
|
|---|
| 146 | if ($cmd eq "mkcol") {
|
|---|
| 147 | run_gencmd($cmd,$col,$cgi);
|
|---|
| 148 | }
|
|---|
| 149 | elsif ($cmd eq "import") {
|
|---|
| 150 | run_gencmd($cmd,$col,$cgi);
|
|---|
| 151 | }
|
|---|
| 152 | elsif ($cmd eq "buildcol") {
|
|---|
| 153 | run_buildcol($col,$cgi);
|
|---|
| 154 | }
|
|---|
| 155 | elsif ($cmd eq "deldir") {
|
|---|
| 156 | run_deldir($col,$cgi);
|
|---|
| 157 | }
|
|---|
| 158 | else {
|
|---|
| 159 | print "Error: unrecognised command: '$cmd'";
|
|---|
| 160 | }
|
|---|
| 161 |
|
|---|
| 162 |
|
|---|
| 163 |
|
|---|
| 164 |
|
|---|
| 165 | # print "<html><head></head><body>value = $value\n</body></html>";
|
|---|
| 166 | }
|
|---|
| 167 |
|
|---|
| 168 | &main();
|
|---|
| 169 |
|
|---|
