[Bio] / FigWebServices / install_subsystem_dir.cgi Repository:
ViewVC logotype

Annotation of /FigWebServices/install_subsystem_dir.cgi

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1 - (view) (download)

1 : olson 1.1
2 :     #
3 :     # Install a subsystem directory as invoked by $fig->install_subsystem_directory_on_server.
4 :     #
5 :     # CGI params:
6 :     #
7 :     # ssa => subsystem name
8 :     # tarfile => uploaded tarfile
9 :     #
10 :    
11 :     use strict;
12 :     use FIG_Config;
13 :     use FIG;
14 :     use Data::Dumper;
15 :    
16 :     my $cgi = new CGI;
17 :    
18 :     my $ssa = $cgi->param('ssa');
19 :    
20 :     if ($ssa eq '')
21 :     {
22 :     &error("No SS name provided");
23 :     }
24 :    
25 :     if ($ssa =~ m,[/\s], or $ssa =~ /^\./)
26 :     {
27 :     &error("Invalid subsystem name");
28 :     }
29 :    
30 :     my $subsys_dir = "$FIG_Config::data/Subsystems/$ssa";
31 :    
32 :     #
33 :     # Try to create the subsys dir. If it fails due to subsystem already existing,
34 :     # we already had the subsys. If it failed for some other reason, relay that as well.
35 :     #
36 :    
37 :     my $rc = mkdir($subsys_dir);
38 :     if (!$rc)
39 :     {
40 :     if ($! =~ /exists/)
41 :     {
42 :     &error("Subsystem already exists ($subsys_dir $!)");
43 :     }
44 :     else
45 :     {
46 :     &error("Cannot create subsystem directory for $ssa: $!");
47 :     }
48 :     }
49 :    
50 :     #
51 :     # If we've gotten this far we should be in good shape. Try to untar.
52 :     #
53 :    
54 :     my $fh = $cgi->upload('tarfile');
55 :    
56 :     if (!$fh)
57 :     {
58 :     &error("Missing file");
59 :     }
60 :    
61 :     my $tarout = "$FIG_Config::temp/tar.out.$$";
62 :     if (!open(TAR, "|tar -C $subsys_dir -v -x -f - -z > $tarout 2>&1"))
63 :     {
64 :     system("rm -rf $subsys_dir");
65 :     unlink($tarout);
66 :     error("Error running tar: $!");
67 :     }
68 :    
69 :     my $buf;
70 :     while (read($fh, $buf, 4096))
71 :     {
72 :     print TAR $buf;
73 :     }
74 :    
75 :     close(TMP);
76 :     my $rc = close(TAR);
77 :    
78 :     if (!$rc)
79 :     {
80 :     my $err = "error closing tar: \$!=$! \$?=$?";
81 :     my $tar_result = &FIG::file_read($tarout);
82 :     unlink($tarout);
83 :     system("rm -rf $subsys_dir");
84 :     &error($err, $tar_result);
85 :     }
86 :    
87 :     my $tar_result = &FIG::file_read($tarout);
88 :     unlink($tarout);
89 :    
90 :     #
91 :     # Make sure it was a valid subsystem
92 :     #
93 :    
94 :     if (! -f "$subsys_dir/spreadsheet")
95 :     {
96 :     system("rm -rf $subsys_dir");
97 :     &error("Upload was not a valid subsystem", $tar_result);
98 :     }
99 :    
100 :     #
101 :     # Index.
102 :     #
103 :    
104 :     my $tmp = "$FIG_Config::temp/index.$$.tmp";
105 :     my $cmd = "$FIG_Config::bin/index_subsystems $ssa > $tmp 2>&1";
106 :     my $rc = system($cmd);
107 :     my $sub_result = &FIG::file_read($tmp);
108 :     unlink($tmp);
109 :     if ($rc != 0)
110 :     {
111 :     system("rm -rf $subsys_dir");
112 :     &error("error indexing subsystems", "rc=$rc cmd=$cmd\nresult:\n$sub_result\n");
113 :     }
114 :    
115 :    
116 :     print $cgi->header(-type => 'text/plain');
117 :     print "Successfully created $ssa\n";
118 :     print $tar_result;
119 :     print $sub_result;
120 :     exit(0);
121 :    
122 :     sub error
123 :     {
124 :     my($msg, $content) = @_;
125 :    
126 :     print $cgi->header(-status => "500 error", -type => 'text/plain');
127 :     print $msg;
128 :     if ($content)
129 :     {
130 :     print "\n$content";
131 :     }
132 :     exit(0);
133 :     }

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3