source: trunk/gsdl/cgi-bin/launch@ 10213

Last change on this file since 10213 was 10213, checked in by davidb, 19 years ago

Removal of Windows specific code. Now done more generally.

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 5.3 KB
Line 
1#!/usr/bin/perl -w
2
3use gsdlCGI;
4
5sub load_gsdl_utils
6{
7 my ($gsdlhome) = @_;
8
9 require "$gsdlhome/perllib/util.pm";
10}
11
12sub run_gencmd
13{
14 my ($prog,$col,$gsdl_cgi) = @_;
15
16 my @arg_keys = $gsdl_cgi->param;
17
18 my $os = $gsdl_cgi->get_gsdl_os();
19
20 my $cmd = "perl -S $prog.pl ";
21
22 foreach my $k ( @arg_keys ) {
23 my $arg_val = $gsdl_cgi->clean_param($k);
24 if ($k eq "about") {
25 # special case (allow most things, but not quotes)
26 $arg_val =~ s/\"/"/g;
27 }
28 else {
29 # ensure only alphanumeric, plus a few special chars
30 $arg_val = $gsdl_cgi->safe_val($arg_val);
31 }
32 $cmd .= " -$k";
33 if ($arg_val ne "") {
34 $cmd .= " \"$arg_val\"";
35 }
36 }
37
38 $cmd .= " $col" if (defined $col);
39
40 my $status;
41
42 print STDOUT "Content-type:text/plain\n\n";
43
44 my $report = "";
45
46 if (open(PIN,"$cmd 2>&1 |")) {
47 while (defined (my $line=<PIN>)) {
48 print STDOUT $line;
49 $report .= $line;
50 }
51 close(PIN);
52
53 $status = $?;
54
55 if ($status>0) {
56 $status = $status/256;
57 my $exit_status = "Exit status: $status\n";
58 my $mess = "'".$cmd."' failed.\n$report\n$exit_status";
59 $gsdl_cgi->generate_error($mess);
60 }
61 }
62 else {
63 $gsdl_cgi->generate_error("Unable to execute cmd: $cmd");
64 $status = -1;
65 }
66
67 return $status;
68}
69
70
71sub run_xmlinfo
72{
73 my ($cmd,$col,$gsdl_cgi) = @_;
74
75 if (defined $col) {
76 $gsdl_cgi->param(-name=>"collect",-value=>$col);
77 $col = undef;
78 }
79
80 if ($cmd eq "pluginfo") {
81 my $plug = $gsdl_cgi->clean_param("plug");
82
83 if (defined $plug) {
84 $gsdl_cgi->delete("plug");
85 $col = $gsdl_cgi->safe_val($plug);
86 }
87 }
88 elsif ($cmd eq "classinfo") {
89 my $class = $gsdl_cgi->clean_param("class");
90
91 if (defined $class) {
92 $gsdl_cgi->delete("class");
93 $col = $gsdl_cgi->safe_val($class);
94 }
95 }
96
97 return run_gencmd($cmd,$col,$gsdl_cgi);
98}
99
100
101sub run_buildcol
102{
103 my ($gsdlhome,$col,$gsdl_cgi) = @_;
104
105 my $full_col_dir = &util::filename_cat($gsdlhome,"collect",$col);
106 my $full_building = &util::filename_cat($full_col_dir,"building");
107 my $full_index = &util::filename_cat($full_col_dir,"index");
108
109 if (defined $col) {
110 &util::rm_r($full_building);
111 &util::mk_dir($full_building);
112 }
113
114 my $status = run_gencmd("buildcol",$col,$gsdl_cgi);
115
116 if ($status == 0) {
117 if (defined $col) {
118 &util::rm_r($full_index);
119
120 # While it is more efficient to move the building directory
121 # to become the index folder, this gets things out of order
122 # back on the client. Use copy for now as this makes things
123 # simpler for now.
124
125 my $full_building_here = &util::filename_cat($full_building,".");
126 &util::cp_r($full_building_here,$full_index);
127 }
128 }
129 # no need to do else clause as error message will have already
130 # been generated.
131}
132
133sub run_exportcol
134{
135 my ($gsdlhome,$col,$gsdl_cgi) = @_;
136
137 # multiple collections represented by ':' concatenated list
138 $col =~ s/:/ /g;
139
140 if (defined $col) {
141 my ($remote_user) = ($col =~ m/^([^\-]+)/);
142
143 my $cddir = $gsdl_cgi->clean_param("cddir");
144
145 my $remote_dirname = &util::filename_cat($gsdlhome,"tmp",$remote_user);
146 my $remote_cd_dirname = &util::filename_cat($remote_dirname,$cddir);
147
148 if (!-e $remote_dirname) {
149 &util::mk_dir($remote_dirname);
150 }
151
152 if (-e $remote_cd_dirname) {
153 &util::rm_r($remote_cd_dirname);
154 }
155
156 # Update cddir cgi param prefiexed by remote_user
157 $cddir = &util::filename_cat($remote_user,$cddir);
158 $gsdl_cgi->delete("cddir");
159 $gsdl_cgi->param(-name=>"cddir", -value=>$cddir);
160 }
161
162 return run_gencmd("exportcol",$col,$gsdl_cgi);
163}
164
165sub run_exportas
166{
167 my ($col,$gsdl_cgi) = @_;
168
169 # multiple collections represented by ':' concatenated list
170 $col =~ s/:/ /g;
171
172 return run_gencmd("export",$col,$gsdl_cgi);
173}
174
175
176
177sub run_deldir
178{
179 my ($col,$gsdl_cgi) = @_;
180
181 if ((!defined $col) || ($col =~ m/^\s*$/)) {
182 $gsdl_cgi->generate_error( "No collection name specified");
183 }
184
185 $gsdl_cgi->checked_chdir("collect");
186
187 my $dir = $gsdl_cgi->clean_param("dir");
188 $dir = "" if ($dir eq ".");
189
190 $gsdl_cgi->local_rm_r("$col/$dir");
191 $gsdl_cgi->checked_chdir("..");
192
193 $gsdl_cgi->generate_ok_message("$col deleted successfully");
194}
195
196sub main
197{
198 my $gsdl_cgi = new gsdlCGI("+cmdline");
199
200 $gsdl_cgi->setup_gsdl();
201 my $gsdlhome = $ENV{'GSDLHOME'};
202
203 load_gsdl_utils($gsdlhome);
204
205 $gsdl_cgi->checked_chdir($gsdlhome);
206
207 my $cmd = $gsdl_cgi->clean_param("cmd");
208 if (!defined $cmd) {
209 $gsdl_cgi->generate_error("No command specified.");
210 }
211
212 $gsdl_cgi->delete("cmd");
213 $cmd =~ s/\..*$//;
214 $cmd = $gsdl_cgi->safe_val($cmd);
215
216 my $col = $gsdl_cgi->clean_param("c");
217
218 $gsdl_cgi->delete("c");
219 $col = $gsdl_cgi->safe_val($col);
220
221 if ($cmd eq "mkcol") {
222 run_gencmd($cmd,$col,$gsdl_cgi);
223 }
224 elsif ($cmd eq "pluginfo") {
225 run_xmlinfo($cmd,$col,$gsdl_cgi);
226 }
227 elsif ($cmd eq "classinfo") {
228 run_xmlinfo($cmd,$col,$gsdl_cgi);
229 }
230 elsif ($cmd eq "import") {
231 run_gencmd($cmd,$col,$gsdl_cgi);
232 }
233 elsif ($cmd eq "buildcol") {
234 run_buildcol($gsdlhome,$col,$gsdl_cgi);
235 }
236 elsif ($cmd eq "exportcol") {
237 run_exportcol($gsdlhome,$col,$gsdl_cgi);
238 }
239 elsif ($cmd eq "exportas") {
240 run_exportas($col,$gsdl_cgi);
241 }
242 elsif ($cmd eq "deldir") {
243 run_deldir($col,$gsdl_cgi);
244 }
245 else {
246 $gsdl_cgi->generate_error("unrecognised command: '$cmd'");
247 }
248}
249
250&main();
251
Note: See TracBrowser for help on using the repository browser.