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

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

Removed the "authentication_enabled" option because it is important to know the username for various things; authentication is now always enabled.

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