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'\n";
|
---|
160 | exit 1;
|
---|
161 | }
|
---|
162 |
|
---|
163 | }
|
---|
164 |
|
---|
165 | &main();
|
---|
166 |
|
---|