source: greenstone3/trunk/web/WEB-INF/cgi/gliserver4gs3.pl@ 14314

Last change on this file since 14314 was 14314, checked in by qq6, 17 years ago

added gliserver4gs3.pl
  • Property svn:executable set to *
File size: 35.6 KB
Line 
1#!/perl -w
2# Need to specify the full path of Perl above
3#print STDOUT "Content-type:text/plain\n\n";
4
5&main;
6
7use gsdlCGI4gs3;
8use strict;
9
10my $debugging_enabled = 1;
11
12my $mail_enabled = 0;
13my $mail_to_address = "user\@server"; # Set this appropriately
14my $mail_from_address = "user\@server"; # Set this appropriately
15my $mail_smtp_server = "smtp.server"; # Set this appropriately
16
17sub main
18{
19 my $gsdl_cgi = new gsdlCGI4gs3();
20
21 # Load the Greenstone modules that we need to use
22 $gsdl_cgi->setup_gsdl();
23
24 my $gsdlhome = $ENV{'GSDLHOME'};
25 $gsdl_cgi->checked_chdir($gsdlhome);
26 require "$gsdlhome/perllib/util.pm"; # This is OK on Windows
27 require "$gsdlhome/perllib/cpan/Crypt/UnixCrypt.pm"; # This is OK on Windows
28
29 # Encrypt the password
30 if (defined $gsdl_cgi->param("pw")) {
31 #$gsdl_cgi->param('-name' => "pw", '-value' => &Crypt::UnixCrypt::crypt($gsdl_cgi->clean_param("pw"), "Tp"));
32 }
33
34 $gsdl_cgi->parse_cgi_args();
35
36 # We don't want the gsdlCGI module to return errors and warnings in XML
37 $gsdl_cgi->{'xml'} = 0;
38
39 # Retrieve the (required) command CGI argument
40 my $cmd = $gsdl_cgi->clean_param("cmd");
41 if (!defined $cmd) {
42 $gsdl_cgi->generate_error("No command specified.");
43 }
44 $gsdl_cgi->delete("cmd");
45
46 # The check-installation command has no arguments
47 if ($cmd eq "check-installation") {
48 print "Content-type: text/html\n\n";
49 &check_installation($gsdl_cgi);
50 return;
51 }
52
53 # All other commands require a username, for locking and authentication
54 my $username = $gsdl_cgi->clean_param("un");
55 if ((!defined $username) || ($username =~ m/^\s*$/)) {
56 $gsdl_cgi->generate_error("No username specified.");
57 }
58 $gsdl_cgi->delete("un");
59
60 # Get then remove the ts (timestamp) argument (since this can mess up other scripts)
61 my $timestamp = $gsdl_cgi->clean_param("ts");
62 if ((!defined $timestamp) || ($timestamp =~ m/^\s*$/)) {
63 $timestamp = time(); # Fall back to using the Perl time() function to generate a timestamp
64 }
65 $gsdl_cgi->delete("ts");
66
67 my $site= $gsdl_cgi->clean_param("site");
68 if (!defined $site) {
69 #$gsdl_cgi->generate_error("No site specified.");
70 }
71 $gsdl_cgi->delete("site");
72
73 if ($cmd eq "delete-collection") {
74 &delete_collection($gsdl_cgi, $username, $timestamp, $site);
75 }
76 elsif ($cmd eq "download-collection") {
77 &download_collection($gsdl_cgi, $username, $timestamp, $site);
78 }
79 elsif ($cmd eq "download-collection-archives") {
80 &download_collection_archives($gsdl_cgi, $username, $timestamp, $site);
81 }
82 elsif ($cmd eq "download-collection-configurations") {
83 &download_collection_configurations($gsdl_cgi, $username, $timestamp, $site);
84 }
85 elsif ($cmd eq "download-collection-file") {
86 &download_collection_file($gsdl_cgi, $username, $timestamp, $site);
87 }
88 elsif ($cmd eq "download-web-xml-file") {
89 &download_web_xml_file($gsdl_cgi, $username, $timestamp, $site);
90 }
91 elsif ($cmd eq "upload-collection-file") {
92 &upload_collection_file($gsdl_cgi, $username, $timestamp, $site);
93 }
94 elsif ($cmd eq "delete-collection-file") {
95 &delete_collection_file($gsdl_cgi, $username, $timestamp, $site);
96 }
97 elsif ($cmd eq "get-script-options") {
98 &get_script_options($gsdl_cgi, $username, $timestamp, $site);
99 }
100 elsif ($cmd eq "get-site-names") {
101 &get_site_names($gsdl_cgi, $username, $timestamp, $site);
102 }
103 elsif ($cmd eq "move-collection-file") {
104 &move_collection_file($gsdl_cgi, $username, $timestamp, $site);
105 }
106 elsif ($cmd eq "new-collection-directory") {
107 &new_collection_directory($gsdl_cgi, $username, $timestamp, $site);
108 }
109 elsif ($cmd eq "authenticate_user") {
110 &authenticate_user($gsdl_cgi, $username, "a1-t1", $site);
111 }
112 elsif ($cmd eq "run-script") {
113 &run_script($gsdl_cgi, $username, $timestamp, $site);
114 }
115 elsif ($cmd eq "timeout-test") {
116 while (1) { }
117 }
118 else {
119 $gsdl_cgi->generate_error("Unrecognised command: '$cmd'");
120 }
121}
122
123
124sub authenticate_user
125{
126
127 my $gsdl_cgi = shift(@_);
128 my $username = shift(@_);
129 my $collection = shift(@_);
130 my $site = shift(@_);
131
132 # Even if we're not authenticating remove the un and pw arguments, since these can mess up other scripts
133 my $user_password = $gsdl_cgi->clean_param("pw");
134 $gsdl_cgi->delete("pw");
135
136 # Only authenticate if it is enabled
137 # return "all-collections-editor" if (!$authentication_enabled);
138
139 if ((!defined $user_password) || ($user_password =~ m/^\s*$/)) {
140 $gsdl_cgi->generate_error("Authentication failed: no password specified.");
141 }
142
143 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
144
145 my $java = $gsdl_cgi->get_java_path();
146 my $java_gsdl3_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "gsdl3.jar");
147 my $java_derby_classpath = &util::filename_cat($gsdl3srchome, "web", "WEB-INF", "lib", "derby.jar");
148 my $java_classpath="classes/:" . $java_gsdl3_classpath . ":" . $java_derby_classpath;
149
150 my $java_args = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "etc", "usersDB");
151 my $java_command="$java -classpath \"$java_classpath\" org.greenstone.gsdl3.util.DerbyWrapper \"$java_args\" 2>&1";
152 my $users_db_content = `$java_command`;
153
154 # Get the user account information from the usersDB database
155 my %users_db_data = ();
156 foreach my $users_db_entry (split(/-{70}/, $users_db_content)) {
157 if ($users_db_entry =~ /\n?\[(.+)\]\n/) {
158 $users_db_data{$1} = $users_db_entry;
159 }
160 }
161
162 # Check username
163 my $user_data = $users_db_data{$username};
164 if (!defined $user_data) {
165 $gsdl_cgi->generate_error("Authentication failed: no account for user '$username'.");
166 }
167
168 # Check password
169 my ($valid_user_password) = ($user_data =~ /\<password\>(.*)/);
170 if ($user_password ne $valid_user_password) {
171 $gsdl_cgi->generate_error("Authentication failed: incorrect password.");
172 }
173
174 # Check group
175 my ($user_groups) = ($user_data =~ /\<groups\>(.*)/);
176
177 if ($collection eq "") {
178 # If we're not editing a collection then the user doesn't need to be in a particular group
179 return $user_groups; # Authentication successful
180 }
181
182 foreach my $user_group (split(/\,/, $user_groups)) {
183 # Does this user have access to all collections?
184 if ($user_group eq "all-collections-editor") {
185 return $user_groups; # Authentication successful
186 }
187 # Does this user have access to personal collections, and is this one?
188 if ($user_group eq "personal-collections-editor" && $collection =~ /^$username\-/) {
189 return $user_groups; # Authentication successful
190 }
191 # Does this user have access to this collection
192 if ($user_group eq "$collection-collection-editor") {
193 return $user_groups; # Authentication successful
194 }
195 }
196 $gsdl_cgi->generate_error("Authentication failed: user is not in the required group.");
197}
198
199
200sub lock_collection
201{
202 my $gsdl_cgi = shift(@_);
203 my $username = shift(@_);
204 my $collection = shift(@_);
205 my $site = shift(@_);
206
207 my $steal_lock = $gsdl_cgi->clean_param("steal_lock");
208 $gsdl_cgi->delete("steal_lock");
209
210 my $gsdlhome = $ENV{'GSDLHOME'};
211 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
212 my $collection_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect", $collection);
213 $gsdl_cgi->checked_chdir($collection_directory);
214
215 # Check if a lock file already exists for this collection
216 my $lock_file_name = "gli.lck";
217 if (-e $lock_file_name) {
218 # A lock file already exists... check if it's ours
219 my $lock_file_content = "";
220 open(LOCK_FILE, "<$lock_file_name");
221 while (<LOCK_FILE>) {
222 $lock_file_content .= $_;
223 }
224 close(LOCK_FILE);
225
226 # Pick out the owner of the lock file
227 $lock_file_content =~ /\<User\>(.*?)\<\/User\>/;
228 my $lock_file_owner = $1;
229
230 # The lock file is ours, so there is no problem
231 if ($lock_file_owner eq $username) {
232 return;
233 }
234
235 # The lock file is not ours, so throw an error unless "steal_lock" is set
236 unless (defined $steal_lock) {
237 $gsdl_cgi->generate_error("Collection is locked by: $lock_file_owner");
238 }
239 }
240
241 my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime(time);
242 my $current_time = sprintf("%02d/%02d/%d %02d:%02d:%02d", $mday, $mon + 1, $year + 1900, $hour, $min, $sec);
243
244 # Create a lock file for us (in the same format as the GLI) and we're done
245 open(LOCK_FILE, ">$lock_file_name");
246 print LOCK_FILE "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n";
247 print LOCK_FILE "<LockFile>\n";
248 print LOCK_FILE " <User>" . $username . "</User>\n";
249 print LOCK_FILE " <Machine>(Remote)</Machine>\n";
250 print LOCK_FILE " <Date>" . $current_time . "</Date>\n";
251 print LOCK_FILE "</LockFile>\n";
252 close(LOCK_FILE);
253}
254
255
256# ----------------------------------------------------------------------------------------------------
257# ACTIONS
258# ----------------------------------------------------------------------------------------------------
259
260
261sub check_installation
262{
263 my ($gsdl_cgi) = @_;
264
265 my $installation_ok = 1;
266 my $installation_status = "";
267
268 # Check that Java is installed and accessible
269 my $java = $gsdl_cgi->get_java_path();
270 my $java_command = "$java -version 2>&1";
271 my $java_output = `$java_command`;
272 my $java_status = $?;
273 print "<pre>";
274 print "$java_output";
275 print "</pre>";
276 if ($java_status < 0) {
277 # The Java command failed
278 $installation_status = "Java failed -- do you have the Java run-time installed?\n" . $gsdl_cgi->check_java_home() . "\n";
279 $installation_ok = 0;
280 }
281 else {
282 $installation_status = "Java found: $java_output";
283 }
284
285 # Show the values of some important environment variables
286 $installation_status .= "\n";
287 $installation_status .= "GSDL3SRCHOME: " . $ENV{'GSDL3SRCHOME'} . "\n";
288 $installation_status .= "GSDLHOME: " . $ENV{'GSDLHOME'} . "\n";
289 $installation_status .= "GSDLOS: " . $ENV{'GSDLOS'} . "\n";
290 $installation_status .= "PATH: " . $ENV{'PATH'} . "\n";
291
292 if ($installation_ok) {
293 $gsdl_cgi->generate_ok_message($installation_status . "\nInstallation OK!");
294 }
295 else {
296 $gsdl_cgi->generate_error($installation_status);
297 }
298}
299
300
301sub delete_collection
302{
303 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
304
305 my $collection = $gsdl_cgi->clean_param("c");
306 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
307 $gsdl_cgi->generate_error("No collection specified.");
308 }
309
310 # Ensure the user is allowed to edit this collection
311 &authenticate_user($gsdl_cgi, $username, $collection, $site);
312
313 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
314 my $gsdlhome = $ENV{'GSDLHOME'};
315 my $collect_directory = &util::filename_cat($gsdl3srchome, "web", $site, "collect");
316 $gsdl_cgi->checked_chdir($collect_directory);
317
318 # Check that the collection exists
319 if (!-d $collection) {
320 $gsdl_cgi->generate_error("Collection $collection does not exist.");
321 }
322
323 # Make sure the collection isn't locked by someone else
324 &lock_collection($gsdl_cgi, $username, $collection, $site);
325
326 $gsdl_cgi->checked_chdir($collect_directory);
327 $gsdl_cgi->local_rm_r("$collection");
328
329 # Check that the collection was deleted
330 if (-e $collection) {
331 $gsdl_cgi->generate_error("Could not delete collection $collection.");
332 }
333
334 $gsdl_cgi->generate_ok_message("Collection $collection deleted successfully.");
335}
336
337
338sub delete_collection_file
339{
340 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
341
342 my $collection = $gsdl_cgi->clean_param("c");
343 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
344 $gsdl_cgi->generate_error("No collection specified.");
345 }
346 my $file = $gsdl_cgi->clean_param("file");
347 if ((!defined $file) || ($file =~ m/^\s*$/)) {
348 $gsdl_cgi->generate_error("No file specified.");
349 }
350 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
351
352 # Make sure we don't try to delete anything outside the collection
353 if ($file =~ /\.\./) {
354 $gsdl_cgi->generate_error("Illegal file specified.");
355 }
356
357 # Ensure the user is allowed to edit this collection
358 #&authenticate_user($gsdl_cgi, $username, $collection, $site);
359
360 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
361 my $gsdlhome = $ENV{'GSDLHOME'};
362 my $collection_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect", $collection);
363 if (!-d $collection_directory){
364 $gsdl_cgi->generate_ok_message("Directory $collection_directory does not exist.");
365 die;
366 }
367
368 $gsdl_cgi->checked_chdir($collection_directory);
369
370 # Make sure the collection isn't locked by someone else
371 &lock_collection($gsdl_cgi, $username, $collection, $site);
372
373 # Check that the collection file exists
374 if (!-e $file) {
375 $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
376 die;
377 }
378 $gsdl_cgi->local_rm_r("$file");
379
380 # Check that the collection file was deleted
381 if (-e $file) {
382 $gsdl_cgi->generate_error("Could not delete collection file $file.");
383 }
384
385 $gsdl_cgi->generate_ok_message("Collection file $file deleted successfully.");
386}
387
388
389sub download_collection
390{
391 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
392
393 my $collection = $gsdl_cgi->clean_param("c");
394 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
395 $gsdl_cgi->generate_error("No collection specified.");
396 }
397
398 # Ensure the user is allowed to edit this collection
399 &authenticate_user($gsdl_cgi, $username, $collection, $site);
400
401 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
402 my $gsdlhome = $ENV{'GSDLHOME'};
403 my $collect_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect");
404
405 $gsdl_cgi->checked_chdir($collect_directory);
406
407
408 # Check that the collection exists
409 if (!-d $collection) {
410 $gsdl_cgi->generate_ok_message("Collection $collection does not exist.");
411 die;
412 }
413
414 # Make sure the collection isn't locked by someone else
415 &lock_collection($gsdl_cgi, $username, $collection, $site);
416
417 # Zip up the collection
418 my $java = $gsdl_cgi->get_java_path();
419 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
420 my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-" . $timestamp . ".zip");
421 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\" gsdl3";
422 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args";
423
424 my $java_output = `$java_command`;
425 my $java_status = $?;
426 if ($java_status > 0) {
427 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
428 }
429
430 # Check that the zip file was created successfully
431 if (!-e $zip_file_path || -z $zip_file_path) {
432 $gsdl_cgi->generate_error("Collection zip file $zip_file_path could not be created.");
433 }
434
435 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
436 unlink("$zip_file_path") unless $debugging_enabled;
437}
438
439
440sub download_collection_archives
441{
442 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
443
444 my $collection = $gsdl_cgi->clean_param("c");
445 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
446 $gsdl_cgi->generate_error("No collection specified.");
447 }
448
449 # Ensure the user is allowed to edit this collection
450 &authenticate_user($gsdl_cgi, $username, $collection, $site);
451
452 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
453 my $gsdlhome = $ENV{'GSDLHOME'};
454 my $collect_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect");
455 $gsdl_cgi->checked_chdir($collect_directory);
456
457 # Check that the collection archives exist
458 if (!-d &util::filename_cat($collection, "archives")) {
459 $gsdl_cgi->generate_error("Collection archives do not exist.");
460 }
461
462 # Make sure the collection isn't locked by someone else
463 &lock_collection($gsdl_cgi, $username, $collection, $site);
464
465 # Zip up the collection archives
466 my $java = $gsdl_cgi->get_java_path();
467 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
468 my $zip_file_path = &util::filename_cat($collect_directory, $collection . "-archives-" . $timestamp . ".zip");
469 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
470 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";
471
472 my $java_output = `$java_command`;
473 my $java_status = $?;
474 if ($java_status > 0) {
475 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
476 }
477
478 # Check that the zip file was created successfully
479 if (!-e $zip_file_path || -z $zip_file_path) {
480 $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
481 }
482
483 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
484 unlink("$zip_file_path") unless $debugging_enabled;
485}
486
487
488# Collection locking unnecessary because this action isn't related to a particular collection
489sub download_collection_configurations
490{
491 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
492
493 # Users can be in any group to perform this action
494 my $user_groups = &authenticate_user($gsdl_cgi, $username, "", $site);
495 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
496 my $gsdlhome = $ENV{'GSDLHOME'};
497 my $collect_directory = &util::filename_cat($gsdl3srchome, "web", "sites",$site, "collect");
498 $gsdl_cgi->checked_chdir($collect_directory);
499
500 # Zip up the collection configurations
501 my $java = $gsdl_cgi->get_java_path();
502 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
503 my $zip_file_path = &util::filename_cat($collect_directory, "collection-configurations-" . $timestamp . ".zip");
504 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$username\" \"$user_groups\"";
505 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args";
506 my $java_output = `$java_command`;
507 my $java_status = $?;
508 if ($java_status > 0) {
509 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
510 }
511
512 # Check that the zip file was created successfully
513 if (!-e $zip_file_path || -z $zip_file_path) {
514 $gsdl_cgi->generate_error("Collection configurations zip file $zip_file_path could not be created.");
515 }
516
517 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
518 unlink("$zip_file_path") unless $debugging_enabled;
519}
520
521
522sub download_collection_file
523{
524 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
525
526 my $collection = $gsdl_cgi->clean_param("c");
527 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
528 $gsdl_cgi->generate_error("No collection specified.");
529 }
530 my $file = $gsdl_cgi->clean_param("file");
531 if ((!defined $file) || ($file =~ m/^\s*$/)) {
532 $gsdl_cgi->generate_error("No file specified.");
533 }
534 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
535
536 # Make sure we don't try to download anything outside the collection
537 if ($file =~ /\.\./) {
538 $gsdl_cgi->generate_error("Illegal file specified.");
539 }
540
541 # Ensure the user is allowed to edit this collection
542 &authenticate_user($gsdl_cgi, $username, $collection, $site);
543
544 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
545 my $gsdlhome = $ENV{'GSDLHOME'};
546 my $collection_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect", $collection);
547 $gsdl_cgi->checked_chdir($collection_directory);
548
549 # Check that the collection file exists
550 if (!-e $file) {
551 $gsdl_cgi->generate_ok_message("Collection file $file does not exist.");
552 die;
553 }
554
555 # Make sure the collection isn't locked by someone else
556 &lock_collection($gsdl_cgi, $username, $collection, $site);
557
558 # Zip up the collection file
559 my $java = $gsdl_cgi->get_java_path();
560 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
561 my $zip_file_path = &util::filename_cat($collection_directory, $collection . "-file-" . $timestamp . ".zip");
562 my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\"";
563 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
564 print "$java_command \n";
565 my $java_output = `$java_command`;
566 my $java_status = $?;
567 if ($java_status > 0) {
568 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
569 }
570
571 # Check that the zip file was created successfully
572 if (!-e $zip_file_path || -z $zip_file_path) {
573 $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
574 }
575
576 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
577 unlink("$zip_file_path") unless $debugging_enabled;
578}
579
580# download web.xml from the server
581sub download_web_xml_file
582{
583 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
584
585 my $file = $gsdl_cgi->clean_param("file");
586 if ((!defined $file) || ($file =~ m/^\s*$/)) {
587 $gsdl_cgi->generate_error("No file specified.");
588 }
589 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
590
591 # Make sure we don't try to download anything else
592 if ($file =~ /\.\./) {
593 $gsdl_cgi->generate_error("Illegal file specified.");
594 }
595
596 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
597 my $gsdlhome = $ENV{'GSDLHOME'};
598 my $web_inf_directory = &util::filename_cat($gsdl3srchome, "web", "WEB-INF");
599 $gsdl_cgi->checked_chdir($web_inf_directory);
600
601 # Check that the collection file exists
602 if (!-e $file) {
603 $gsdl_cgi->generate_error("file $file does not exist.");
604 }
605
606
607 # Zip up the collection file
608 my $java = $gsdl_cgi->get_java_path();
609 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
610 my $zip_file_path = &util::filename_cat($web_inf_directory, "webxml" . $timestamp . ".zip");
611 my $java_args = "\"$zip_file_path\" \"$web_inf_directory\" \"$file\"";
612 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
613 my $java_output = `$java_command`;
614
615 my $java_status = $?;
616 if ($java_status > 0) {
617 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
618 }
619
620 # Check that the zip file was created successfully
621 if (!-e $zip_file_path || -z $zip_file_path) {
622 $gsdl_cgi->generate_error("web.xml zip file $zip_file_path could not be created.");
623 }
624
625 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
626 unlink("$zip_file_path") unless $debugging_enabled;
627}
628
629# Collection locking unnecessary because this action isn't related to a particular collection
630sub get_script_options
631{
632 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
633
634 my $script = $gsdl_cgi->clean_param("script");
635 if ((!defined $script) || ($script =~ m/^\s*$/)) {
636 $gsdl_cgi->generate_error("No script specified.");
637 }
638 $gsdl_cgi->delete("script");
639
640 # Users can be in any group to perform this action
641 &authenticate_user($gsdl_cgi, $username, "", $site);
642 $gsdl_cgi->delete("ts");
643 $gsdl_cgi->delete("pw");
644
645 my $perl_args = "";
646 if ($script eq "classinfo.pl") {
647 $perl_args = $gsdl_cgi->clean_param("classifier") || "";
648 $gsdl_cgi->delete("classifier");
649 }
650 if ($script eq "pluginfo.pl") {
651 $perl_args = $gsdl_cgi->clean_param("plugin") || "";
652 $gsdl_cgi->delete("plugin");
653 }
654
655 foreach my $cgi_arg_name ($gsdl_cgi->param) {
656 my $cgi_arg_value = $gsdl_cgi->clean_param($cgi_arg_name) || "";
657 $cgi_arg_value = $gsdl_cgi->safe_val($cgi_arg_value);
658 if ($cgi_arg_value eq "") {
659 $perl_args = "-$cgi_arg_name " . $perl_args;
660 }
661 else {
662 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
663 }
664 }
665
666 my $perl_command = "perl -S $script $perl_args 2>&1";
667 my $perl_output = `$perl_command`;
668 my $perl_status = $?;
669 if ($perl_status > 0) {
670 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\n$perl_output\nExit status: " . ($perl_status / 256));
671 }
672
673 print STDOUT "Content-type:text/plain\n\n";
674 print STDOUT $perl_output;
675}
676
677# get the names of all sites available on the server
678sub get_site_names
679{
680 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
681 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
682 my $gsdlhome = $ENV{'GSDLHOME'};
683 my $sites_directory = &util::filename_cat($gsdl3srchome, "web", "sites");
684
685 my @sites_dir;
686 my @site_dir;
687
688 $gsdl_cgi->checked_chdir($sites_directory);
689 opendir(DIR, $sites_directory);
690 @sites_dir= readdir(DIR);
691 my $sites_dir;
692 my $sub_dir_file;
693
694 print STDOUT "Content-type:text/plain\n\n";
695 foreach $sites_dir(@sites_dir)
696 {
697 if (!(($sites_dir eq ".") || ($sites_dir eq "..") || ($sites_dir eq "CVS")))
698 {
699 my $site_dir_path= &util::filename_cat($sites_directory,$sites_dir);
700 $gsdl_cgi->checked_chdir($site_dir_path);
701 opendir(DIR,$site_dir_path);
702 @site_dir=readdir(DIR);
703 closedir(DIR);
704
705 foreach $sub_dir_file(@site_dir)
706 {
707 if ($sub_dir_file eq "siteConfig.xml"){
708 print STDOUT "$sites_dir" . "-----";
709 }
710 }
711 }
712 }
713
714}
715
716sub move_collection_file
717{
718 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
719
720 my $collection = $gsdl_cgi->clean_param("c");
721 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
722 $gsdl_cgi->generate_error("No collection specified.");
723 }
724 my $source_file = $gsdl_cgi->clean_param("source");
725 if ((!defined $source_file) || ($source_file =~ m/^\s*$/)) {
726 $gsdl_cgi->generate_error("No source file specified.");
727 }
728 $source_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
729 my $target_file = $gsdl_cgi->clean_param("target");
730 if ((!defined $target_file) || ($target_file =~ m/^\s*$/)) {
731 $gsdl_cgi->generate_error("No target file specified.");
732 }
733 $target_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
734
735 # Make sure we don't try to move anything outside the collection
736 if ($source_file =~ /\.\./ || $target_file =~ /\.\./) {
737 $gsdl_cgi->generate_error("Illegal file specified.");
738 }
739
740 # Ensure the user is allowed to edit this collection
741 &authenticate_user($gsdl_cgi, $username, $collection, $site);
742
743 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
744 my $gsdlhome = $ENV{'GSDLHOME'};
745 my $collection_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect", $collection);
746 $gsdl_cgi->checked_chdir($collection_directory);
747
748 # Check that the collection source file exists
749 if (!-e $source_file) {
750 $gsdl_cgi->generate_error("Collection file $source_file does not exist.");
751 }
752
753 # Make sure the collection isn't locked by someone else
754 &lock_collection($gsdl_cgi, $username, $collection, $site);
755
756 &util::mv($source_file, $target_file);
757
758 # Check that the collection source file was moved
759 if (-e $source_file || !-e $target_file) {
760 $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file.");
761 }
762
763 $gsdl_cgi->generate_ok_message("Collection file $source_file moved to $target_file successfully.");
764}
765
766
767sub new_collection_directory
768{
769 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
770
771 my $collection = $gsdl_cgi->clean_param("c");
772 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
773 $gsdl_cgi->generate_error("No collection specified.");
774 }
775 my $directory = $gsdl_cgi->clean_param("directory");
776 if ((!defined $directory) || ($directory =~ m/^\s*$/)) {
777 $gsdl_cgi->generate_error("No directory specified.");
778 }
779 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
780
781 # Make sure we don't try to create anything outside the collection
782 if ($directory =~ /\.\./) {
783 $gsdl_cgi->generate_error("Illegal directory specified.");
784 }
785
786 # Ensure the user is allowed to edit this collection
787 &authenticate_user($gsdl_cgi, $username, $collection, $site);
788
789 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
790 my $gsdlhome = $ENV{'GSDLHOME'};
791 my $collection_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect", $collection);
792 $gsdl_cgi->checked_chdir($collection_directory);
793
794 # Check that the collection directory doesn't already exist
795 # ZipTools doesn't zip up empty directories, so this causes an error when downloading a new collection as we explicity
796 # try to create the import directory
797 if (-d $directory) {
798 $gsdl_cgi->generate_error("Collection directory $directory already exists.");
799 }
800
801 # Make sure the collection isn't locked by someone else
802 &lock_collection($gsdl_cgi, $username, $collection, $site);
803
804 &util::mk_dir($directory);
805
806 # Check that the collection directory was created
807 if (!-d $directory) {
808 $gsdl_cgi->generate_error("Could not create collection directory $directory.");
809 }
810
811 $gsdl_cgi->generate_ok_message("Collection directory $directory created successfully.");
812}
813
814
815sub run_script
816{
817 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
818
819 my $script = $gsdl_cgi->clean_param("script");
820 if ((!defined $script) || ($script =~ m/^\s*$/)) {
821 $gsdl_cgi->generate_error("No script specified.");
822 }
823 $gsdl_cgi->delete("script");
824 my $collection = $gsdl_cgi->clean_param("c");
825 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
826 $gsdl_cgi->generate_error("No collection specified.");
827 }
828 $gsdl_cgi->delete("c");
829
830 # confuse other, so delete timestamp
831 $gsdl_cgi->delete("ts");
832
833 # Ensure the user is allowed to edit this collection
834 &authenticate_user($gsdl_cgi, $username, $collection, $site);
835
836 # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course)
837 &lock_collection($gsdl_cgi, $username, $collection, $site) unless ($script eq "mkcol.pl");
838
839 # Last argument is the collection name, except for explode_metadata_database.pl
840 my $perl_args = $collection;
841 if ($script eq "explode_metadata_database.pl") {
842 # Last argument is the file to be exploded
843 my $file = $gsdl_cgi->clean_param("file");
844 if ((!defined $file) || ($file =~ m/^\s*$/)) {
845 $gsdl_cgi->generate_error("No file specified.");
846 }
847 $gsdl_cgi->delete("file");
848 $perl_args = $file;
849 }
850
851 foreach my $cgi_arg_name ($gsdl_cgi->param) {
852 my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param($cgi_arg_name));
853 if ($cgi_arg_value eq "") {
854 $perl_args = "-$cgi_arg_name " . $perl_args;
855 }
856 else {
857 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
858 }
859 }
860
861 if (($script eq "import.pl") || ($script eq "buildcol.pl")){
862 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
863 my $collect_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect");
864 $perl_args = $perl_args . " -collectdir " . $collect_directory;
865 }
866
867 if ($script eq "mkcol.pl"){
868 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
869 my $collect_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect");
870 $perl_args = $perl_args . " -collectdir " . $collect_directory;
871 }
872
873 my $perl_command = "perl -S $script $perl_args 2>&1";
874 if (!open(PIN, "$perl_command |")) {
875 $gsdl_cgi->generate_error("Unable to execute command: $perl_command");
876 }
877
878 print STDOUT "Content-type:text/plain\n\n";
879 print "$perl_command \n";
880
881 while (defined (my $perl_output_line = <PIN>)) {
882 print STDOUT $perl_output_line;
883 }
884 close(PIN);
885
886 my $perl_status = $?;
887 if ($perl_status > 0) {
888 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\nExit status: " . ($perl_status / 256));
889 }
890 elsif ($mail_enabled) {
891 if ($script eq "buildcol.pl") {
892 &send_mail($gsdl_cgi, "Remote Greenstone building event", "Build of collection '$collection' complete.");
893 }
894 }
895}
896
897sub upload_collection_file
898{
899 my ($gsdl_cgi, $username, $timestamp, $site) = @_;
900
901 my $collection = $gsdl_cgi->clean_param("c");
902 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
903 $gsdl_cgi->generate_error("No collection specified.");
904 }
905 my $file = $gsdl_cgi->clean_param("file");
906 if ((!defined $file) || ($file =~ m/^\s*$/)) {
907 $gsdl_cgi->generate_error("No file specified.");
908 }
909 my $directory = $gsdl_cgi->clean_param("directory") || "";
910 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
911 my $zip = $gsdl_cgi->clean_param("zip");
912
913 # Make sure we don't try to upload anything outside the collection
914 if ($file =~ /\.\./) {
915 $gsdl_cgi->generate_error("Illegal file specified.");
916 }
917 if ($directory =~ /\.\./) {
918 $gsdl_cgi->generate_error("Illegal directory specified.");
919 }
920
921 # Ensure the user is allowed to edit this collection
922 &authenticate_user($gsdl_cgi, $username, $collection, $site);
923
924 my $gsdl3srchome = $ENV{'GSDL3SRCHOME'};
925 my $gsdlhome = $ENV{'GSDLHOME'};
926 my $collection_directory = &util::filename_cat($gsdl3srchome, "web", "sites", $site, "collect", $collection);
927 $gsdl_cgi->checked_chdir($collection_directory);
928
929 # Make sure the collection isn't locked by someone else
930 &lock_collection($gsdl_cgi, $username, $collection, $site);
931
932 my $directory_path = &util::filename_cat($collection_directory, $directory);
933 if (!-d $directory_path) {
934 &util::mk_dir($directory_path);
935 if (!-d $directory_path) {
936 $gsdl_cgi->generate_error("Could not create directory $directory_path.");
937 }
938 }
939
940 #my $file_path = &util::filename_cat($directory_path, $file . "-" . $timestamp);
941 my $file_path = &util::filename_cat($directory_path, $file);
942
943 if (!open(FOUT, ">$file_path")) {
944 $gsdl_cgi->generate_error("Unable to write file $file_path");
945 }
946
947 # Read the uploaded data and write it out to file
948 my $buf;
949 my $num_bytes = 0;
950 binmode(FOUT);
951 my $bread;
952 my $fh=$gsdl_cgi->clean_param("uploaded_file");
953
954 while ($bread=read($fh, $buf, 1024)) {
955 print FOUT $buf;
956 }
957
958 close(FOUT);
959 # If we have downloaded a zip file, unzip it
960 if (defined $zip) {
961 my $java = $gsdl_cgi->get_java_path();
962 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
963 my $java_args = "\"$file_path\" \"$directory_path\"";
964 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.Unzip $java_args";
965
966 my $java_output = `$java_command`;
967 my $java_status = $?;
968
969 # Remove the zip file once we have unzipped it, since it is an intermediate file only
970 unlink("$file_path");
971
972 if ($java_status > 0) {
973 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
974 }
975 }
976
977 $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully.");
978}
979
980sub put_file
981{
982 my $gsdl_cgi = shift(@_);
983 my $file_path = shift(@_);
984 my $content_type = shift(@_);
985
986 if (open(PIN, "<$file_path")) {
987 print STDOUT "Content-type:application/zip\n\n";
988 my $buf;
989 my $num_bytes = 0;
990 binmode(PIN);
991 while (read(PIN, $buf, 1024) > 0) {
992 print STDOUT $buf;
993 $num_bytes += length($buf);
994 }
995
996 close(PIN);
997 }
998 else {
999 $gsdl_cgi->generate_error("Unable to read file $file_path\n $!");
1000 }
1001}
1002
1003
1004sub send_mail
1005{
1006 my $gsdl_cgi = shift(@_);
1007 my $mail_subject = shift(@_);
1008 my $mail_content = shift(@_);
1009
1010 my $sendmail_command = "perl -S sendmail.pl";
1011 $sendmail_command .= " -to \"" . $mail_to_address . "\"";
1012 $sendmail_command .= " -from \"" . $mail_from_address . "\"";
1013 $sendmail_command .= " -smtp \"" . $mail_smtp_server . "\"";
1014 $sendmail_command .= " -subject \"" . $mail_subject . "\"";
1015
1016 if (!open(POUT, "| $sendmail_command")) {
1017 $gsdl_cgi->generate_error("Unable to execute command: $sendmail_command");
1018 }
1019 print POUT $mail_content . "\n";
1020 close(POUT);
1021}
Note: See TracBrowser for help on using the repository browser.