source: trunk/gsdl/cgi-bin/gliserver.pl@ 13809

Last change on this file since 13809 was 13809, checked in by mdewsnip, 17 years ago

All requests to gliserver.pl now include a timestamp as the "ts" argument.

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