1#!/usr/local/bin/perl
2# install_pack.cgi
3# Install a package from some source
4
5require './cluster-software-lib.pl';
6if ($ENV{REQUEST_METHOD} eq "POST") {
7	&ReadParse(\%getin, "GET");
8	&ReadParseMime(undef, \&read_parse_mime_callback, [ $getin{'id'} ]);
9	}
10else {
11	&ReadParse();
12	$no_upload = 1;
13	}
14&error_setup($text{'install_err'});
15
16if ($in{source} == 2) {
17	&ui_print_unbuffered_header(undef, $text{'install_title'}, "", "install_pack");
18	}
19else {
20	&ui_print_header(undef, $text{'install_title'}, "", "install_pack");
21	}
22
23if ($in{source} == 0) {
24	# installing from local file (or maybe directory)
25	if (!$in{'local'})
26		{ &install_error($text{'install_elocal'}); }
27	if (!-r $in{'local'})
28		{ &install_error(&text('install_elocal2', $in{'local'})); }
29	$source = $in{'local'};
30	$pfile = $in{'local'};
31	$filename = $in{'local'};
32	$filename =~ s/^(.*)[\\\/]//;
33	$need_unlink = 0;
34	}
35elsif ($in{source} == 1) {
36	# installing from upload .. store file in temp location
37	if ($no_upload) {
38		&install_error($text{'install_eupload'});
39		}
40	$in{'upload_filename'} =~ /([^\/\\]+$)/;
41	$filename = $in{'upload_filename'};
42	$filename =~ s/^(.*)[\\\/]//;
43	$pfile = &tempname("$1");
44	&open_tempfile(PFILE, ">$pfile");
45	&print_tempfile(PFILE, $in{'upload'});
46	&close_tempfile(PFILE);
47	$source = $in{'upload_filename'};
48	$need_unlink = 1;
49	}
50elsif ($in{source} == 2) {
51	# installing from URL.. store downloaded file in temp location
52	$in{'url'} =~ /\/([^\/]+)\/*$/;
53	$pfile = &tempname("$1");
54	$progress_callback_url = $in{'url'};
55	if ($in{'url'} =~ /^(http|https):\/\/([^\/]+)(\/.*)$/) {
56		# Make a HTTP request
57		$ssl = $1 eq 'https';
58		$host = $2; $page = $3; $port = $ssl ? 443 : 80;
59		if ($host =~ /^(.*):(\d+)$/) { $host = $1; $port = $2; }
60		&http_download($host, $port, $page, $pfile, \$error,
61			       \&progress_callback, $ssl);
62		}
63	elsif ($in{'url'} =~ /^ftp:\/\/([^\/]+)(:21)?(\/.*)$/) {
64		$host = $1; $file = $3;
65		&ftp_download($host, $file, $pfile, \$error,
66			      \&progress_callback);
67		}
68	else { &install_error(&text('install_eurl', $in{'url'})); }
69	&install_error($error) if ($error);
70	$source = $in{'url'};
71	$need_unlink = 1;
72	$filename = $in{'url'};
73	$filename =~ s/^(.*)[\\\/]//;
74	}
75elsif ($in{source} == 3) {
76	# installing from some update system, so nothing to do here
77	$pfile = $in{'update'};
78	@rv = map { $_." ".$_ } split(/\s+/, $in{'update'});
79	}
80
81# Check if any remote systems are using the same package system
82@anysame = grep { &same_package_system($_) } &list_software_hosts();
83@anydiff = grep { !&same_package_system($_) } &list_software_hosts();
84
85# Check validity, if we can
86$invalid_msg = undef;
87if ($in{'source'} != 3) {
88	$ps = &software::package_system();
89	if (!&software::is_package($pfile)) {
90		if (-d $pfile) {
91			&install_error(&text('install_edir', $ps));
92			}
93		else {
94			# attempt to uncompress
95			local $unc = &software::uncompress_if_needed(
96				$pfile, $need_unlink);
97			if ($unc ne $pfile) {
98				# uncompressed ok..
99				if (!&software::is_package($unc)) {
100					# but still not valid :(
101					unlink($unc);
102					$invalid_msg =
103						&text('install_ezip', $ps);
104					}
105				else {
106					$pfile = $unc;
107					}
108				}
109			else {
110				# uncompress failed.. give up
111				$invalid_msg = &text('install_efile', $ps);
112				}
113			}
114		}
115
116	if (!$invalid_msg) {
117		# ask for package to install and install options
118		@rv = &software::file_packages($pfile);
119		}
120	}
121
122if ($invalid_msg) {
123	# Could not check package .. but this is OK if we have any remote
124	# systems of different types
125	if (@anydiff) {
126		$filename =~ s/\.[a-z]+$//i;
127		@rv = ( $filename );
128		$unknownfile = $filename;
129		}
130	else {
131		unlink($pfile) if ($need_unlink);
132		&install_error($invalid_msg);
133		}
134	}
135
136# Show install form
137print &ui_form_start("do_install.cgi");
138print &ui_hidden("file", $pfile);
139print &ui_hidden("unknownfile", $unknownfile);
140print &ui_hidden("need_unlink", $need_unlink);
141print &ui_hidden("source", $in{'source'});
142print &ui_hidden("ssl", $ssl);
143print &ui_hidden("host", $host);
144print &ui_hidden("page", $page);
145print &ui_hidden("port", $port);
146print &ui_hidden("ftpfile", $file);
147print &ui_hidden("down", $in{'down'});
148print &ui_table_start($text{'install_header'}, undef, 4);
149
150# Packages to install
151$plist = "";
152foreach (@rv) {
153	($p, $d) = split(/\s+/, $_, 2);
154	if ($d && $d ne $p) {
155		$plist .= &html_escape($d)." (".&html_escape($p).")<br>\n";
156		}
157	else {
158		$plist .= &html_escape($p)."<br>\n";
159		}
160	}
161print &ui_table_row($text{'install_packs'}, $plist, 3);
162
163# Type-specific options
164if ($in{'source'} != 3 && !@anydiff) {
165	&software::install_options($pfile, $p);
166	}
167
168# Show input for hosts to install on
169&create_on_input($text{'install_servers'},
170		 $in{'source'} == 3, $in{'source'} == 3);
171
172print &ui_table_end();
173print &ui_form_end([ [ undef, $text{'install_ok'} ] ]);
174
175
176&ui_print_footer("", $text{'index_return'});
177
178sub install_error
179{
180print "<b>$main::whatfailed : $_[0]</b> <p>\n";
181&ui_print_footer("", $text{'index_return'});
182exit;
183}
184
185