source: trunk/gsdl/cgi-bin/gliserver@ 10727

Last change on this file since 10727 was 10727, checked in by mdewsnip, 18 years ago

Replaced the old "download", "launch" and "upload" GLI applet scripts with the new "gliserver" script (for the remote Greenstone building functionality -- West Yorkshire).

  • Property svn:executable set to *
  • Property svn:keywords set to Author Date Id Revision
File size: 25.3 KB
Line 
1#!/usr/bin/perl -w
2
3
4use gsdlCGI;
5
6# The version of Perl distributed with Greenstone on Windows doesn't have crypt, so use this instead
7use Crypt::UnixCrypt;
8
9
10my $authentication_enabled = 1;
11my $debugging_enabled = 0;
12
13
14sub main
15{
16 my $gsdl_cgi = new gsdlCGI("+cmdline");
17
18 # Encrypt the password
19 if (defined $gsdl_cgi->param("pw")) {
20 $gsdl_cgi->param('-name' => "pw", '-value' => crypt($gsdl_cgi->clean_param("pw"), "Tp"));
21 }
22
23 $gsdl_cgi->parse_cgi_args();
24 $gsdl_cgi->setup_gsdl();
25
26 my $gsdlhome = $ENV{'GSDLHOME'};
27 $gsdl_cgi->checked_chdir($gsdlhome);
28 require "$gsdlhome/perllib/util.pm"; # This is OK on Windows
29
30 my $cmd = $gsdl_cgi->clean_param("cmd");
31 if (!defined $cmd) {
32 $gsdl_cgi->generate_error("No command specified.");
33 }
34 $gsdl_cgi->delete("cmd");
35
36 # All commands require a username, for locking and authentication
37 my $username = $gsdl_cgi->clean_param("un");
38 if ((!defined $username) || ($username =~ m/^\s*$/)) {
39 $gsdl_cgi->generate_error("No username specified.");
40 }
41 $gsdl_cgi->delete("un");
42
43 if ($cmd eq "delete-collection") {
44 &delete_collection($gsdl_cgi, $username);
45 }
46 elsif ($cmd eq "download-collection") {
47 &download_collection($gsdl_cgi, $username);
48 }
49 elsif ($cmd eq "download-collection-archives") {
50 &download_collection_archives($gsdl_cgi, $username);
51 }
52 elsif ($cmd eq "download-collection-configurations") {
53 &download_collection_configurations($gsdl_cgi, $username);
54 }
55 elsif ($cmd eq "download-collection-file") {
56 &download_collection_file($gsdl_cgi, $username);
57 }
58 elsif ($cmd eq "delete-collection-file") {
59 &delete_collection_file($gsdl_cgi, $username);
60 }
61 elsif ($cmd eq "get-script-options") {
62 &get_script_options($gsdl_cgi, $username);
63 }
64 elsif ($cmd eq "move-collection-file") {
65 &move_collection_file($gsdl_cgi, $username);
66 }
67 elsif ($cmd eq "new-collection-directory") {
68 &new_collection_directory($gsdl_cgi, $username);
69 }
70 elsif ($cmd eq "run-script") {
71 &run_script($gsdl_cgi, $username);
72 }
73 elsif ($cmd eq "timeout-test") {
74 while (1) { }
75 }
76 elsif ($cmd eq "upload-collection-file") {
77 &upload_collection_file($gsdl_cgi, $username);
78 }
79 else {
80 $gsdl_cgi->generate_error("Unrecognised command: '$cmd'");
81 }
82}
83
84
85sub authenticate_user
86{
87 my $gsdl_cgi = shift(@_);
88 my $username = shift(@_);
89 my $user_group_required = shift(@_);
90
91 # Even if we're not authenticating remove the un and pw arguments, since these can mess up other scripts
92 my $user_password = $gsdl_cgi->clean_param("pw");
93 $gsdl_cgi->delete("pw");
94
95 # Only authenticate if it is enabled
96 return if (!$authentication_enabled);
97
98 if ((!defined $user_password) || ($user_password =~ m/^\s*$/)) {
99 $gsdl_cgi->generate_error("Authentication failed: no password specified.");
100 }
101
102 my $gsdlhome = $ENV{'GSDLHOME'};
103 my $etc_directory = &util::filename_cat($gsdlhome, "etc");
104 my $users_db_file_path = &util::filename_cat($etc_directory, "users.db");
105
106 # Use db2txt instead of GDBM_File to get the user accounts information
107 my $users_db_content = "";
108 open(USERS_DB, "db2txt \"$users_db_file_path\" |");
109 while (<USERS_DB>) {
110 $users_db_content .= $_;
111 }
112
113 # Get the user account information from the users.db database
114 my %users_db_data = ();
115 foreach my $users_db_entry (split(/-{70}/, $users_db_content)) {
116 if ($users_db_entry =~ /\n?\[(.+)\]\n/) {
117 $users_db_data{$1} = $users_db_entry;
118 }
119 }
120
121 # Check username
122 my $user_data = $users_db_data{$username};
123 if (!defined $user_data) {
124 $gsdl_cgi->generate_error("Authentication failed: no account for user '$username'.");
125 }
126
127 # Check password
128 my ($valid_user_password) = ($user_data =~ /\<password\>(.*)/);
129 if ($user_password ne $valid_user_password) {
130 $gsdl_cgi->generate_error("Authentication failed: incorrect password.");
131 }
132
133 # Check group
134 my ($user_groups) = ($user_data =~ /\<groups\>(.*)/);
135 foreach my $user_group (split(/\,/, $user_groups)) {
136 if ($user_group eq $user_group_required || $user_group eq "remote-superuser") {
137 # Authentication successful!
138 return;
139 }
140 }
141
142 $gsdl_cgi->generate_error("Authentication failed: user is not in the required group.");
143}
144
145
146sub lock_collection
147{
148 my $gsdl_cgi = shift(@_);
149 my $collection = shift(@_);
150 my $username = shift(@_);
151
152 my $steal_lock = $gsdl_cgi->clean_param("steal_lock");
153 $gsdl_cgi->delete("steal_lock");
154
155 my $gsdlhome = $ENV{'GSDLHOME'};
156 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection);
157 $gsdl_cgi->checked_chdir($collection_directory);
158
159 # Check if a lock file already exists for this collection
160 my $lock_file_name = "gli.lck";
161 if (-e $lock_file_name) {
162 # A lock file already exists... check if it's ours
163 open(LOCK_FILE, "<$lock_file_name");
164 my $lock_file_owner = <LOCK_FILE>;
165 close(LOCK_FILE);
166
167 # The lock file is ours, so there is no problem
168 if ($lock_file_owner eq $username) {
169 return;
170 }
171
172 # The lock file is not ours, so throw an error unless "steal_lock" is set
173 unless (defined $steal_lock) {
174 $gsdl_cgi->generate_error("Collection is locked by: $lock_file_owner");
175 }
176 }
177
178 # Create a lock file for us and we're done
179 open(LOCK_FILE, ">$lock_file_name");
180 print LOCK_FILE "$username";
181 close(LOCK_FILE);
182}
183
184
185# ----------------------------------------------------------------------------------------------------
186# ACTIONS
187# ----------------------------------------------------------------------------------------------------
188
189
190sub delete_collection
191{
192 my ($gsdl_cgi, $username) = @_;
193
194 my $collection = $gsdl_cgi->clean_param("c");
195 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
196 $gsdl_cgi->generate_error("No collection specified.");
197 }
198
199 # Users must be in the <collection>-maintainer group to perform this action
200 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
201
202 my $gsdlhome = $ENV{'GSDLHOME'};
203 my $collect_directory = &util::filename_cat($gsdlhome, "collect");
204 $gsdl_cgi->checked_chdir($collect_directory);
205
206 # Check that the collection exists
207 if (!-d $collection) {
208 $gsdl_cgi->generate_error("Collection $collection does not exist.");
209 }
210
211 # Make sure the collection isn't locked by someone else
212 &lock_collection($gsdl_cgi, $collection, $username);
213
214 $gsdl_cgi->checked_chdir($collect_directory);
215 $gsdl_cgi->local_rm_r("$collection");
216
217 # Check that the collection was deleted
218 if (-e $collection) {
219 $gsdl_cgi->generate_error("Could not delete collection $collection.");
220 }
221
222 $gsdl_cgi->generate_ok_message("Collection $collection deleted successfully.");
223}
224
225
226sub delete_collection_file
227{
228 my ($gsdl_cgi, $username) = @_;
229
230 my $collection = $gsdl_cgi->clean_param("c");
231 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
232 $gsdl_cgi->generate_error("No collection specified.");
233 }
234 my $file = $gsdl_cgi->clean_param("file");
235 if ((!defined $file) || ($file =~ m/^\s*$/)) {
236 $gsdl_cgi->generate_error("No file specified.");
237 }
238 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
239
240 # Make sure we don't try to delete anything outside the collection
241 if ($file =~ /\.\./) {
242 $gsdl_cgi->generate_error("Illegal file specified.");
243 }
244
245 # Users must be in the <collection>-maintainer group to perform this action
246 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
247
248 my $gsdlhome = $ENV{'GSDLHOME'};
249 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection);
250 $gsdl_cgi->checked_chdir($collection_directory);
251
252 # Make sure the collection isn't locked by someone else
253 &lock_collection($gsdl_cgi, $collection, $username);
254
255 # Check that the collection file exists
256 if (!-e $file) {
257 $gsdl_cgi->generate_error("Collection file $file does not exist.");
258 }
259 $gsdl_cgi->local_rm_r("$file");
260
261 # Check that the collection file was deleted
262 if (-e $file) {
263 $gsdl_cgi->generate_error("Could not delete collection file $file.");
264 }
265
266 $gsdl_cgi->generate_ok_message("Collection file $file deleted successfully.");
267}
268
269
270sub download_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 # Users must be in the <collection>-maintainer group to perform this action
280 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
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, $collection, $username);
293
294 # Zip up the collection
295 my $java = $gsdl_cgi->get_java_path();
296 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
297 my $zip_file_path = &util::filename_cat($collect_directory, $username . "-" . $collection . ".zip");
298 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
299 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionShell $java_args";
300
301 my $java_output = `$java_command`;
302 my $java_status = $?;
303 if ($java_status > 0) {
304 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
305 }
306
307 # Check that the zip file was created successfully
308 if (!-e $zip_file_path || -z $zip_file_path) {
309 $gsdl_cgi->generate_error("Collection zip file $zip_file_path could not be created.");
310 }
311
312 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
313 unlink("$zip_file_path") unless $debugging_enabled;
314}
315
316
317sub download_collection_archives
318{
319 my ($gsdl_cgi, $username) = @_;
320
321 my $collection = $gsdl_cgi->clean_param("c");
322 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
323 $gsdl_cgi->generate_error("No collection specified.");
324 }
325
326 # Users must be in the <collection>-maintainer group to perform this action
327 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
328
329 my $gsdlhome = $ENV{'GSDLHOME'};
330 my $collect_directory = &util::filename_cat($gsdlhome, "collect");
331 $gsdl_cgi->checked_chdir($collect_directory);
332
333 # Check that the collection archives exist
334 if (!-d &util::filename_cat($collection, "archives")) {
335 $gsdl_cgi->generate_error("Collection archives do not exist.");
336 }
337
338 # Make sure the collection isn't locked by someone else
339 &lock_collection($gsdl_cgi, $collection, $username);
340
341 # Zip up the collection archives
342 my $java = $gsdl_cgi->get_java_path();
343 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
344 my $zip_file_path = &util::filename_cat($collect_directory, $username . "-" . $collection . "-archives.zip");
345 my $java_args = "\"$zip_file_path\" \"$collect_directory\" \"$collection\"";
346 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionArchives $java_args";
347
348 my $java_output = `$java_command`;
349 my $java_status = $?;
350 if ($java_status > 0) {
351 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
352 }
353
354 # Check that the zip file was created successfully
355 if (!-e $zip_file_path || -z $zip_file_path) {
356 $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
357 }
358
359 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
360 unlink("$zip_file_path") unless $debugging_enabled;
361}
362
363
364# Collection locking unnecessary because this action isn't related to a particular collection
365sub download_collection_configurations
366{
367 my ($gsdl_cgi, $username) = @_;
368
369 # Users must be in the remote-collection-builder group to perform this action
370 &authenticate_user($gsdl_cgi, $username, "remote-collection-builder");
371
372 my $gsdlhome = $ENV{'GSDLHOME'};
373 my $collect_directory = &util::filename_cat($gsdlhome, "collect");
374 $gsdl_cgi->checked_chdir($collect_directory);
375
376 # Zip up the collection configurations
377 my $java = $gsdl_cgi->get_java_path();
378 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
379 my $zip_file_path = &util::filename_cat($collect_directory, $username . "-" . "collection-configurations.zip");
380 my $java_args = "\"$zip_file_path\" \"$collect_directory\"";
381 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipCollectionConfigurations $java_args";
382
383 my $java_output = `$java_command`;
384 my $java_status = $?;
385 if ($java_status > 0) {
386 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
387 }
388
389 # Check that the zip file was created successfully
390 if (!-e $zip_file_path || -z $zip_file_path) {
391 $gsdl_cgi->generate_error("Collection configurations zip file $zip_file_path could not be created.");
392 }
393
394 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
395 unlink("$zip_file_path") unless $debugging_enabled;
396}
397
398
399sub download_collection_file
400{
401 my ($gsdl_cgi, $username) = @_;
402
403 my $collection = $gsdl_cgi->clean_param("c");
404 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
405 $gsdl_cgi->generate_error("No collection specified.");
406 }
407 my $file = $gsdl_cgi->clean_param("file");
408 if ((!defined $file) || ($file =~ m/^\s*$/)) {
409 $gsdl_cgi->generate_error("No file specified.");
410 }
411 $file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
412
413 # Make sure we don't try to download anything outside the collection
414 if ($file =~ /\.\./) {
415 $gsdl_cgi->generate_error("Illegal file specified.");
416 }
417
418 # Users must be in the <collection>-maintainer group to perform this action
419 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
420
421 my $gsdlhome = $ENV{'GSDLHOME'};
422 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection);
423 $gsdl_cgi->checked_chdir($collection_directory);
424
425 # Check that the collection file exists
426 if (!-e $file) {
427 $gsdl_cgi->generate_error("Collection file $file does not exist.");
428 }
429
430 # Make sure the collection isn't locked by someone else
431 &lock_collection($gsdl_cgi, $collection, $username);
432
433 # Zip up the collection file
434 my $java = $gsdl_cgi->get_java_path();
435 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
436 my $zip_file_path = &util::filename_cat($collection_directory, $username . "-" . $collection . "-file.zip");
437 my $java_args = "\"$zip_file_path\" \"$collection_directory\" \"$file\"";
438 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.remote.ZipFiles $java_args";
439
440 my $java_output = `$java_command`;
441 my $java_status = $?;
442 if ($java_status > 0) {
443 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
444 }
445
446 # Check that the zip file was created successfully
447 if (!-e $zip_file_path || -z $zip_file_path) {
448 $gsdl_cgi->generate_error("Collection archives zip file $zip_file_path could not be created.");
449 }
450
451 &put_file($gsdl_cgi, $zip_file_path, "application/zip");
452 unlink("$zip_file_path") unless $debugging_enabled;
453}
454
455
456# Collection locking unnecessary because this action isn't related to a particular collection
457sub get_script_options
458{
459 my ($gsdl_cgi, $username) = @_;
460
461 my $script = $gsdl_cgi->clean_param("script");
462 if ((!defined $script) || ($script =~ m/^\s*$/)) {
463 $gsdl_cgi->generate_error("No script specified.");
464 }
465 $gsdl_cgi->delete("script");
466
467 # Users must be in the remote-collection-builder group to perform this action
468 &authenticate_user($gsdl_cgi, $username, "remote-collection-builder");
469
470 my $perl_args = "";
471 if ($script eq "classinfo.pl") {
472 $perl_args = $gsdl_cgi->clean_param("classifier") || "";
473 $gsdl_cgi->delete("classifier");
474 }
475 if ($script eq "pluginfo.pl") {
476 $perl_args = $gsdl_cgi->clean_param("plugin") || "";
477 $gsdl_cgi->delete("plugin");
478 }
479
480 foreach my $cgi_arg_name ($gsdl_cgi->param) {
481 my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param($cgi_arg_name));
482 if ($cgi_arg_value eq "") {
483 $perl_args = "-$cgi_arg_name " . $perl_args;
484 }
485 else {
486 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
487 }
488 }
489
490 my $perl_command = "perl -S $script $perl_args 2>&1";
491 my $perl_output = `$perl_command`;
492 my $perl_status = $?;
493 if ($perl_status > 0) {
494 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\n$perl_output\nExit status: " . ($perl_status / 256));
495 }
496
497 print STDOUT "Content-type:text/plain\n\n";
498 print STDOUT $perl_output;
499}
500
501
502sub move_collection_file
503{
504 my ($gsdl_cgi, $username) = @_;
505
506 my $collection = $gsdl_cgi->clean_param("c");
507 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
508 $gsdl_cgi->generate_error("No collection specified.");
509 }
510 my $source_file = $gsdl_cgi->clean_param("source");
511 if ((!defined $source_file) || ($source_file =~ m/^\s*$/)) {
512 $gsdl_cgi->generate_error("No source file specified.");
513 }
514 $source_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
515 my $target_file = $gsdl_cgi->clean_param("target");
516 if ((!defined $target_file) || ($target_file =~ m/^\s*$/)) {
517 $gsdl_cgi->generate_error("No target file specified.");
518 }
519 $target_file =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
520
521 # Make sure we don't try to move anything outside the collection
522 if ($source_file =~ /\.\./ || $target_file =~ /\.\./) {
523 $gsdl_cgi->generate_error("Illegal file specified.");
524 }
525
526 # Users must be in the <collection>-maintainer group to perform this action
527 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
528
529 my $gsdlhome = $ENV{'GSDLHOME'};
530 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection);
531 $gsdl_cgi->checked_chdir($collection_directory);
532
533 # Check that the collection source file exists
534 if (!-e $source_file) {
535 $gsdl_cgi->generate_error("Collection file $source_file does not exist.");
536 }
537
538 # Make sure the collection isn't locked by someone else
539 &lock_collection($gsdl_cgi, $collection, $username);
540
541 &util::mv($source_file, $target_file);
542
543 # Check that the collection source file was moved
544 if (-e $source_file || !-e $target_file) {
545 $gsdl_cgi->generate_error("Could not move collection file $source_file to $target_file.");
546 }
547
548 $gsdl_cgi->generate_ok_message("Collection file $source_file moved to $target_file successfully.");
549}
550
551
552sub new_collection_directory
553{
554 my ($gsdl_cgi, $username) = @_;
555
556 my $collection = $gsdl_cgi->clean_param("c");
557 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
558 $gsdl_cgi->generate_error("No collection specified.");
559 }
560 my $directory = $gsdl_cgi->clean_param("directory");
561 if ((!defined $directory) || ($directory =~ m/^\s*$/)) {
562 $gsdl_cgi->generate_error("No directory specified.");
563 }
564 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
565
566 # Make sure we don't try to create anything outside the collection
567 if ($directory =~ /\.\./) {
568 $gsdl_cgi->generate_error("Illegal directory specified.");
569 }
570
571 # Users must be in the <collection>-maintainer group to perform this action
572 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
573
574 my $gsdlhome = $ENV{'GSDLHOME'};
575 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection);
576 $gsdl_cgi->checked_chdir($collection_directory);
577
578 # Check that the collection directory doesn't already exist
579 if (-d $directory) {
580 $gsdl_cgi->generate_error("Collection directory $directory already exists.");
581 }
582
583 # Make sure the collection isn't locked by someone else
584 &lock_collection($gsdl_cgi, $collection, $username);
585
586 &util::mk_dir($directory);
587
588 # Check that the collection directory was created
589 if (!-d $directory) {
590 $gsdl_cgi->generate_error("Could not create collection directory $directory.");
591 }
592
593 $gsdl_cgi->generate_ok_message("Collection directory $directory created successfully.");
594}
595
596
597sub run_script
598{
599 my ($gsdl_cgi, $username) = @_;
600
601 my $script = $gsdl_cgi->clean_param("script");
602 if ((!defined $script) || ($script =~ m/^\s*$/)) {
603 $gsdl_cgi->generate_error("No script specified.");
604 }
605 $gsdl_cgi->delete("script");
606 my $collection = $gsdl_cgi->clean_param("c");
607 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
608 $gsdl_cgi->generate_error("No collection specified.");
609 }
610 $gsdl_cgi->delete("c");
611
612 # Users must be in the <collection>-maintainer group to perform this action
613 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
614
615 # Make sure the collection isn't locked by someone else (unless we're running mkcol.pl, of course)
616 &lock_collection($gsdl_cgi, $collection, $username) unless ($script eq "mkcol.pl");
617
618 my $perl_args = $collection;
619 foreach my $cgi_arg_name ($gsdl_cgi->param) {
620 my $cgi_arg_value = $gsdl_cgi->safe_val($gsdl_cgi->clean_param($cgi_arg_name));
621 if ($cgi_arg_value eq "") {
622 $perl_args = "-$cgi_arg_name " . $perl_args;
623 }
624 else {
625 $perl_args = "-$cgi_arg_name \"$cgi_arg_value\" " . $perl_args;
626 }
627 }
628
629 my $perl_command = "perl -S $script $perl_args 2>&1";
630 if (!open(PIN, "$perl_command |")) {
631 $gsdl_cgi->generate_error("Unable to execute command: $perl_command");
632 }
633
634 print STDOUT "Content-type:text/plain\n\n";
635 while (defined (my $perl_output_line = <PIN>)) {
636 print STDOUT $perl_output_line;
637 }
638 close(PIN);
639
640 my $perl_status = $?;
641 if ($perl_status > 0) {
642 $gsdl_cgi->generate_error("Perl failed: $perl_command\n--\nExit status: " . ($perl_status / 256));
643 }
644}
645
646
647sub upload_collection_file
648{
649 my ($gsdl_cgi, $username) = @_;
650
651 my $collection = $gsdl_cgi->clean_param("c");
652 if ((!defined $collection) || ($collection =~ m/^\s*$/)) {
653 $gsdl_cgi->generate_error("No collection specified.");
654 }
655 my $file = $gsdl_cgi->clean_param("file");
656 if ((!defined $file) || ($file =~ m/^\s*$/)) {
657 $gsdl_cgi->generate_error("No file specified.");
658 }
659 my $directory = $gsdl_cgi->clean_param("directory") || "";
660 $directory =~ s/\|/&util::get_dirsep()/eg; # Convert the '|' characters into whatever is right for this OS
661 my $zip = $gsdl_cgi->clean_param("zip");
662
663 # Make sure we don't try to upload anything outside the collection
664 if ($file =~ /\.\./) {
665 $gsdl_cgi->generate_error("Illegal file specified.");
666 }
667 if ($directory =~ /\.\./) {
668 $gsdl_cgi->generate_error("Illegal directory specified.");
669 }
670
671 # Users must be in the <collection>-maintainer group to perform this action
672 &authenticate_user($gsdl_cgi, $username, "$collection-maintainer");
673
674 my $gsdlhome = $ENV{'GSDLHOME'};
675 my $collection_directory = &util::filename_cat($gsdlhome, "collect", $collection);
676 $gsdl_cgi->checked_chdir($collection_directory);
677
678 # Make sure the collection isn't locked by someone else
679 &lock_collection($gsdl_cgi, $collection, $username);
680
681 my $directory_path = &util::filename_cat($collection_directory, $directory);
682 &util::mk_dir($directory_path);
683 if (!-e $directory_path) {
684 $gsdl_cgi->generate_error("Could not create directory $directory_path.");
685 }
686
687 my $file_path = &util::filename_cat($directory_path, $username . "-" . $file);
688 if (!open(FOUT, ">$file_path")) {
689 $gsdl_cgi->generate_error("Unable to write file $file_path");
690 }
691
692 # Read the uploaded data and write it out to file
693 my $buf;
694 my $num_bytes = 0;
695 binmode(FOUT);
696 while (read(STDIN, $buf, 1024) > 0) {
697 print FOUT $buf;
698 $num_bytes += length($buf);
699 }
700 close(FOUT);
701
702 # If we have downloaded a zip file, unzip it
703 if (defined $zip) {
704 my $java = $gsdl_cgi->get_java_path();
705 my $java_classpath = &util::filename_cat($gsdlhome, "bin", "java", "GLIServer.jar");
706 my $java_args = "\"$file_path\" \"$directory_path\"";
707 my $java_command = "$java -classpath \"$java_classpath\" org.greenstone.gatherer.util.Unzip $java_args";
708
709 my $java_output = `$java_command`;
710 my $java_status = $?;
711
712 # Remove the zip file once we have unzipped it, since it is an intermediate file only
713 unlink("$file_path");
714
715 if ($java_status > 0) {
716 $gsdl_cgi->generate_error("Java failed: $java_command\n--\n$java_output\nExit status: " . ($java_status / 256) . "\n" . $gsdl_cgi->check_java_home());
717 }
718 }
719
720 $gsdl_cgi->generate_ok_message("Collection file $file uploaded successfully.");
721}
722
723
724sub put_file
725{
726 my $gsdl_cgi = shift(@_);
727 my $file_path = shift(@_);
728 my $content_type = shift(@_);
729
730 if (open(PIN, "<$file_path")) {
731 print STDOUT "Content-type:$content_type\n\n";
732
733 my $buf;
734 my $num_bytes = 0;
735 binmode(PIN);
736 while (read(PIN, $buf, 1024) > 0) {
737 print STDOUT $buf;
738 $num_bytes += length($buf);
739 }
740
741 close(PIN);
742 }
743 else {
744 $gsdl_cgi->generate_error("Unable to read file $file_path\n $!");
745 }
746}
747
748
749&main();
Note: See TracBrowser for help on using the repository browser.