[people/pmueller/ipfire-2.x.git] / html / cgi-bin / updates.cgi

#!/usr/bin/perl\r
#\r
# SmoothWall CGIs\r
#\r
# This code is distributed under the terms of the GPL\r
#\r
# (c) The SmoothWall Team\r
#\r
# $Id: updates.cgi,v 1.9.2.22 2005/12/01 20:41:53 franck78 Exp $\r
#\r
\r
use LWP::UserAgent;\r
use File::Copy;\r
use strict;\r
\r
# enable only the following on debugging purpose\r
#use warnings;\r
#use CGI::Carp 'fatalsToBrowser';\r
\r
require 'CONFIG_ROOT/general-functions.pl';\r
require "${General::swroot}/lang.pl";\r
require "${General::swroot}/header.pl";\r
\r
#workaround to suppress a warning when a variable is used only once\r
my @dummy = ( $General::version );\r
undef (@dummy);\r
my $warnmessage='';\r
my $errormessage='';\r
my @av=('');\r
my @pf=('');\r
\r
&Header::showhttpheaders();\r
\r
my %uploadsettings=();\r
$uploadsettings{'ACTION'} = '';\r
\r
&Header::getcgihash(\%uploadsettings, {'wantfile' => 1, 'filevar' => 'FH'});\r
\r
if ($uploadsettings{'ACTION'} eq $Lang::tr{'upload'}) {\r
# This code do not serve a lot because $General::version cannot change while the module is loaded. So no change\r
# can appear. More, this call should be called 'after' update is done !\r
#	my $return = &downloadlist();\r
#	if ($return && $return->is_success) {\r
#		if (open(LIST, ">${General::swroot}/patches/available")){\r
#			flock LIST, 2;\r
#			my @this = split(/----START LIST----\n/,$return->content);\r
#			print LIST $this[1];\r
#			close(LIST);\r
#		} else {\r
#			$errormessage = $Lang::tr{'could not open available updates file'};\r
#		}\r
#	} else {\r
#		if (open(LIST, "<${General::swroot}/patches/available")) {\r
#			my @list = <LIST>;\r
#			close(LIST);\r
#		}\r
#		$warnmessage = $Lang::tr{'could not download the available updates list'};\r
#	}\r
\r
\r
	if (copy ($uploadsettings{'FH'}, "/var/patches/patch-$$.tar.gz.gpg") != 1) {\r
		$errormessage = $!;\r
	} else {\r
		my $exitcode = system("/usr/local/bin/installpackage $$ > /dev/null") >> 8;\r
		if ($exitcode == 0) {\r
			#Hack to get correct version displayed after update\r
			open (XX,"perl -e \"require'${General::swroot}/general-functions.pl';print \\\$General::version\"|");\r
			$General::version=<XX>;\r
			close (XX);\r
			&General::log("$Lang::tr{'the following update was successfully installed'} ($General::version)");\r
		}\r
		elsif($exitcode == 2) {\r
			$errormessage = "$Lang::tr{'could not create directory'}";\r
		}\r
		elsif($exitcode == 3) {\r
			$errormessage = "$Lang::tr{'this is not an authorised update'}";\r
		}\r
		elsif($exitcode == 4) {\r
			$errormessage = "$Lang::tr{'this is not a valid archive'}";\r
		}\r
		elsif($exitcode == 5) {\r
			$errormessage = "$Lang::tr{'could not open update information file'}";\r
		}\r
		elsif($exitcode == 6) {\r
			$errormessage = "$Lang::tr{'could not open installed updates file'}";\r
		}\r
		elsif($exitcode == 7) {\r
			$errormessage = "$Lang::tr{'this update is already installed'}";\r
		}\r
		elsif($exitcode == 11) {\r
			$errormessage = "$Lang::tr{'not enough disk space'}";\r
		} else {\r
			$errormessage = "$Lang::tr{'package failed to install'}";\r
		}\r
	}\r
}\r
elsif ($uploadsettings{'ACTION'} eq $Lang::tr{'refresh update list'}) {\r
	my $return = &downloadlist();\r
	if ($return && $return->is_success) {\r
		if (open(LIST, ">${General::swroot}/patches/available")) {\r
			flock LIST, 2;\r
			my @this = split(/----START LIST----\n/,$return->content);\r
			print LIST $this[1];\r
			close(LIST);\r
			&General::log($Lang::tr{'successfully refreshed updates list'});\r
		} else {\r
			$errormessage = $Lang::tr{'could not open available updates file'};\r
		}\r
	} else {\r
		$errormessage = $Lang::tr{'could not download the available updates list'}; \r
	}\r
}\r
elsif ($uploadsettings{'ACTION'} eq "$Lang::tr{'clear cache'} (squid)") {\r
        system('/usr/local/bin/restartsquid','-f');\r
}\r
		\r
if (!open(AV, "<${General::swroot}/patches/available")) {\r
    $errormessage = $Lang::tr{'could not open available updates file'};\r
} else {\r
    @av = <AV>;\r
    close(AV);\r
}\r
if (!open (PF, "<${General::swroot}/patches/installed")) {\r
    $errormessage = $Lang::tr{'could not open installed updates file'};\r
} else {\r
    @pf = <PF>;\r
    close (PF);\r
    #substract installed patch from list displayed (AV list may not be updated)\r
    foreach my $P (@pf) {\r
	$P =~ /^(...)/;\r
	my $order=$1;\r
	my $idx=0;\r
	foreach my $A (@av) {\r
	    $A =~ /^(...)/;\r
	    if ($1 eq $order) { # match\r
		splice (@av,$idx,1);\r
		last;\r
	    }\r
	    $idx++;\r
	}	\r
    }\r
}\r
\r
&Header::openpage($Lang::tr{'updates'}, 1, '');\r
\r
&Header::openbigbox('100%', 'left', 'download.png', $errormessage);\r
\r
if ($errormessage) {\r
	&Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
	print $errormessage;\r
	print "&nbsp;";\r
	&Header::closebox();\r
}\r
\r
if ($warnmessage) {\r
	&Header::openbox('100%', 'LEFT', "$Lang::tr{'warning messages'}:");\r
	print "<CLASS NAME='base'>$warnmessage \n";\r
	print "&nbsp;</CLASS>\n";\r
	&Header::closebox();\r
}\r
\r
\r
&Header::openbox('100%', 'left', $Lang::tr{'available updates'});\r
\r
if ( defined $av[0] ) {\r
	print $Lang::tr{'there are updates available'};\r
	print qq|<table width='100%' border='0' cellpadding='2' cellspacing='0'>\r
<tr>\r
<td width='5%'><b>$Lang::tr{'id'}</b></td>\r
<td width='15%'><b>$Lang::tr{'title'}</b></td>\r
<td width='50%'><b>$Lang::tr{'description'}</b></td>\r
<td width='15%'><b>$Lang::tr{'released'}</b></td>\r
<td width='15%'>&nbsp;</td>\r
</tr>\r
|;\r
	foreach (@av) {\r
		my @temp = split(/\|/,$_);\r
		print "<tr><td valign='top'>$temp[0]</td><td valign='top'>$temp[1]</td><td valign='top'>$temp[2]</td><td valign='top'>$temp[3]</td><td valign='top'><a href='$temp[4]' target='_new'>$Lang::tr{'info'}</a></td></tr>";\r
	}\r
	print "</table>";\r
\r
\r
} else {\r
	print $Lang::tr{'all updates installed'};\r
}\r
\r
print qq|<hr /><br>\r
$Lang::tr{'to install an update'}\r
<br />\r
<form method='post' action='/cgi-bin/updates.cgi' enctype='multipart/form-data'>\r
<table>\r
<tr>\r
<td align='right' class='base'>\r
<b>$Lang::tr{'upload update file'}</b></td>\r
<td><input type="file" size='40' name="FH" /> <input type='submit' name='ACTION' value='$Lang::tr{'upload'}' />\r
</td></tr>\r
</table>|;\r
\r
print "<b>$Lang::tr{'disk usage'}</b>";\r
open (XX,'df -h / /var/log|');\r
my @df=<XX>;\r
close (XX);\r
print "<table cellpadding='2'>";\r
map ( $_ =~ s/ +/<td>/g,@df);	# tablify each line!\r
print "<tr><td>$df[0]</tr>";\r
print "<tr><td>$df[1]</tr>";\r
print "<tr><td>$df[2]<td><input type='submit' name='ACTION' value='$Lang::tr{'clear cache'} (squid)' /></tr>";\r
print "</table>";\r
\r
print "\n<hr />";\r
print "\n<table width='100%'>\n<tr>";\r
print "\n\t<td width='50%'>&nbsp;</td>";\r
print "\n\t<td width='50%' align='center'><input type='submit' name='ACTION' value='$Lang::tr{'refresh update list'}' /></td></tr>";\r
print "\n</table>\n";\r
print "</form>";\r
\r
&Header::closebox();\r
\r
&Header::openbox('100%', 'LEFT', $Lang::tr{'installed updates'});\r
\r
print qq|<table width='100%' border='0' cellpadding='2' cellspacing='0'>\r
<tr>\r
<td width='5%'><b>$Lang::tr{'id'}</b></td>\r
<td width='15%'><b>$Lang::tr{'title'}</b></td>\r
<td width='50%'><b>$Lang::tr{'description'}</b></td>\r
<td width='15%'><b>$Lang::tr{'released'}</b></td>\r
<td width='15%'><b>$Lang::tr{'installed'}</b></td>\r
</tr>\r
|;\r
\r
foreach my $pf (@pf) {\r
	next if $pf =~ m/^#/;\r
	my @temp = split(/\|/,$pf);\r
#???	@av = grep(!/^$temp[0]/, @av);\r
	print "<tr><td valign='top'>" . join("</td><td valign='top'>",@temp) . "</td></tr>";\r
}\r
close(PF);\r
\r
print "</table>";\r
\r
&Header::closebox();\r
\r
&Header::closebigbox();\r
\r
&Header::closepage();\r
\r
sub downloadlist {\r
	unless (-e "${General::swroot}/red/active") {\r
		return 0;\r
	}\r
\r
	my $downloader = LWP::UserAgent->new;\r
	$downloader->timeout(5);\r
\r
	my %proxysettings=();\r
	&General::readhash("${General::swroot}/proxy/settings", \%proxysettings);\r
\r
	if ($_=$proxysettings{'UPSTREAM_PROXY'}) {\r
		my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]*?(?:\:[A-Za-z0-9\_\.\-]*?)?\@)?([a-zA-Z0-9\.\_\-]*?)(?:\:([0-9]{1,5}))?(?:\/.*?)?$/);\r
		if ($proxysettings{'UPSTREAM_USER'}) {\r
			$downloader->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$peer:$peerport/");\r
		} else {\r
			$downloader->proxy("http","http://$peer:$peerport/");\r
		}\r
	}\r
\r
	return $downloader->get("http://www.ipcop.org/patches/${General::version}", 'Cache-Control', 'no-cache');\r
\r
}\r
Commit	Line	Data
cd1a2927 MT	1	#!/usr/bin/perl\r
	2	#\r
	3	# SmoothWall CGIs\r
	4	#\r
	5	# This code is distributed under the terms of the GPL\r
	6	#\r
	7	# (c) The SmoothWall Team\r
	8	#\r
	9	# $Id: updates.cgi,v 1.9.2.22 2005/12/01 20:41:53 franck78 Exp $\r
	10	#\r
	11	\r
	12	use LWP::UserAgent;\r
	13	use File::Copy;\r
	14	use strict;\r
	15	\r
	16	# enable only the following on debugging purpose\r
	17	#use warnings;\r
	18	#use CGI::Carp 'fatalsToBrowser';\r
	19	\r
	20	require 'CONFIG_ROOT/general-functions.pl';\r
	21	require "${General::swroot}/lang.pl";\r
	22	require "${General::swroot}/header.pl";\r
	23	\r
	24	#workaround to suppress a warning when a variable is used only once\r
	25	my @dummy = ( $General::version );\r
	26	undef (@dummy);\r
	27	my $warnmessage='';\r
	28	my $errormessage='';\r
	29	my @av=('');\r
	30	my @pf=('');\r
	31	\r
	32	&Header::showhttpheaders();\r
	33	\r
	34	my %uploadsettings=();\r
	35	$uploadsettings{'ACTION'} = '';\r
	36	\r
	37	&Header::getcgihash(\%uploadsettings, {'wantfile' => 1, 'filevar' => 'FH'});\r
	38	\r
	39	if ($uploadsettings{'ACTION'} eq $Lang::tr{'upload'}) {\r
	40	# This code do not serve a lot because $General::version cannot change while the module is loaded. So no change\r
	41	# can appear. More, this call should be called 'after' update is done !\r
	42	# my $return = &downloadlist();\r
	43	# if ($return && $return->is_success) {\r
	44	# if (open(LIST, ">${General::swroot}/patches/available")){\r
	45	# flock LIST, 2;\r
	46	# my @this = split(/----START LIST----\n/,$return->content);\r
	47	# print LIST $this[1];\r
	48	# close(LIST);\r
	49	# } else {\r
	50	# $errormessage = $Lang::tr{'could not open available updates file'};\r
	51	# }\r
	52	# } else {\r
	53	# if (open(LIST, "<${General::swroot}/patches/available")) {\r
	54	# my @list = <LIST>;\r
	55	# close(LIST);\r
	56	# }\r
	57	# $warnmessage = $Lang::tr{'could not download the available updates list'};\r
	58	# }\r
	59	\r
	60	\r
	61	if (copy ($uploadsettings{'FH'}, "/var/patches/patch-$$.tar.gz.gpg") != 1) {\r
	62	$errormessage = $!;\r
	63	} else {\r
	64	my $exitcode = system("/usr/local/bin/installpackage $$ > /dev/null") >> 8;\r
65	if ($exitcode == 0) {\r
66	#Hack to get correct version displayed after update\r
67	open (XX,"perl -e \"require'${General::swroot}/general-functions.pl';print \\\$General::version\"\|");\r
68	$General::version=<XX>;\r
69	close (XX);\r
70	&General::log("$Lang::tr{'the following update was successfully installed'} ($General::version)");\r
71	}\r
72	elsif($exitcode == 2) {\r
73	$errormessage = "$Lang::tr{'could not create directory'}";\r
74	}\r
75	elsif($exitcode == 3) {\r
76	$errormessage = "$Lang::tr{'this is not an authorised update'}";\r
77	}\r
78	elsif($exitcode == 4) {\r
79	$errormessage = "$Lang::tr{'this is not a valid archive'}";\r
80	}\r
81	elsif($exitcode == 5) {\r
82	$errormessage = "$Lang::tr{'could not open update information file'}";\r
83	}\r
84	elsif($exitcode == 6) {\r
85	$errormessage = "$Lang::tr{'could not open installed updates file'}";\r
86	}\r
87	elsif($exitcode == 7) {\r
88	$errormessage = "$Lang::tr{'this update is already installed'}";\r
89	}\r
90	elsif($exitcode == 11) {\r
91	$errormessage = "$Lang::tr{'not enough disk space'}";\r
92	} else {\r
93	$errormessage = "$Lang::tr{'package failed to install'}";\r
94	}\r
95	}\r
96	}\r
97	elsif ($uploadsettings{'ACTION'} eq $Lang::tr{'refresh update list'}) {\r
98	my $return = &downloadlist();\r
99	if ($return && $return->is_success) {\r
100	if (open(LIST, ">${General::swroot}/patches/available")) {\r
101	flock LIST, 2;\r
102	my @this = split(/----START LIST----\n/,$return->content);\r
103	print LIST $this[1];\r
104	close(LIST);\r
105	&General::log($Lang::tr{'successfully refreshed updates list'});\r
106	} else {\r
107	$errormessage = $Lang::tr{'could not open available updates file'};\r
108	}\r
109	} else {\r
110	$errormessage = $Lang::tr{'could not download the available updates list'}; \r
111	}\r
112	}\r
113	elsif ($uploadsettings{'ACTION'} eq "$Lang::tr{'clear cache'} (squid)") {\r
114	system('/usr/local/bin/restartsquid','-f');\r
115	}\r
116	\r
117	if (!open(AV, "<${General::swroot}/patches/available")) {\r
118	$errormessage = $Lang::tr{'could not open available updates file'};\r
119	} else {\r
120	@av = <AV>;\r
121	close(AV);\r
122	}\r
123	if (!open (PF, "<${General::swroot}/patches/installed")) {\r
124	$errormessage = $Lang::tr{'could not open installed updates file'};\r
125	} else {\r
126	@pf = <PF>;\r
127	close (PF);\r
128	#substract installed patch from list displayed (AV list may not be updated)\r
129	foreach my $P (@pf) {\r
130	$P =~ /^(...)/;\r
131	my $order=$1;\r
132	my $idx=0;\r
133	foreach my $A (@av) {\r
134	$A =~ /^(...)/;\r
135	if ($1 eq $order) { # match\r
136	splice (@av,$idx,1);\r
137	last;\r
138	}\r
139	$idx++;\r
140	} \r
141	}\r
142	}\r
143	\r
144	&Header::openpage($Lang::tr{'updates'}, 1, '');\r
145	\r
146	&Header::openbigbox('100%', 'left', 'download.png', $errormessage);\r
147	\r
148	if ($errormessage) {\r
149	&Header::openbox('100%', 'left', $Lang::tr{'error messages'});\r
150	print $errormessage;\r
151	print " ";\r
152	&Header::closebox();\r
153	}\r
154	\r
155	if ($warnmessage) {\r
156	&Header::openbox('100%', 'LEFT', "$Lang::tr{'warning messages'}:");\r
157	print "<CLASS NAME='base'>$warnmessage \n";\r
158	print " </CLASS>\n";\r
159	&Header::closebox();\r
160	}\r
161	\r
162	\r
163	&Header::openbox('100%', 'left', $Lang::tr{'available updates'});\r
164	\r
165	if ( defined $av[0] ) {\r
166	print $Lang::tr{'there are updates available'};\r
167	print qq\|<table width='100%' border='0' cellpadding='2' cellspacing='0'>\r
168	<tr>\r
169	<td width='5%'><b>$Lang::tr{'id'}</b></td>\r
170	<td width='15%'><b>$Lang::tr{'title'}</b></td>\r
171	<td width='50%'><b>$Lang::tr{'description'}</b></td>\r
172	<td width='15%'><b>$Lang::tr{'released'}</b></td>\r
173	<td width='15%'> </td>\r
174	</tr>\r
175	\|;\r
176	foreach (@av) {\r
177	my @temp = split(/\\|/,$_);\r
178	print "<tr><td valign='top'>$temp[0]</td><td valign='top'>$temp[1]</td><td valign='top'>$temp[2]</td><td valign='top'>$temp[3]</td><td valign='top'><a href='$temp[4]' target='_new'>$Lang::tr{'info'}</a></td></tr>";\r
179	}\r
180	print "</table>";\r
181	\r
182	\r
183	} else {\r
184	print $Lang::tr{'all updates installed'};\r
185	}\r
186	\r
187	print qq\|<hr /><br>\r
188	$Lang::tr{'to install an update'}\r
189	<br />\r
190	<form method='post' action='/cgi-bin/updates.cgi' enctype='multipart/form-data'>\r
191	<table>\r
192	<tr>\r
193	<td align='right' class='base'>\r
194	<b>$Lang::tr{'upload update file'}</b></td>\r
195	<td><input type="file" size='40' name="FH" /> <input type='submit' name='ACTION' value='$Lang::tr{'upload'}' />\r
196	</td></tr>\r
197	</table>\|;\r
198	\r
199	print "<b>$Lang::tr{'disk usage'}</b>";\r
200	open (XX,'df -h / /var/log\|');\r
201	my @df=<XX>;\r
202	close (XX);\r
203	print "<table cellpadding='2'>";\r
204	map ( $_ =~ s/ +/<td>/g,@df); # tablify each line!\r
205	print "<tr><td>$df[0]</tr>";\r
206	print "<tr><td>$df[1]</tr>";\r
207	print "<tr><td>$df[2]<td><input type='submit' name='ACTION' value='$Lang::tr{'clear cache'} (squid)' /></tr>";\r
208	print "</table>";\r
209	\r
210	print "\n<hr />";\r
211	print "\n<table width='100%'>\n<tr>";\r
212	print "\n\t<td width='50%'> </td>";\r
213	print "\n\t<td width='50%' align='center'><input type='submit' name='ACTION' value='$Lang::tr{'refresh update list'}' /></td></tr>";\r
214	print "\n</table>\n";\r
215	print "</form>";\r
216	\r
217	&Header::closebox();\r
218	\r
219	&Header::openbox('100%', 'LEFT', $Lang::tr{'installed updates'});\r
220	\r
221	print qq\|<table width='100%' border='0' cellpadding='2' cellspacing='0'>\r
222	<tr>\r
223	<td width='5%'><b>$Lang::tr{'id'}</b></td>\r
224	<td width='15%'><b>$Lang::tr{'title'}</b></td>\r
225	<td width='50%'><b>$Lang::tr{'description'}</b></td>\r
226	<td width='15%'><b>$Lang::tr{'released'}</b></td>\r
227	<td width='15%'><b>$Lang::tr{'installed'}</b></td>\r
228	</tr>\r
229	\|;\r
230	\r
231	foreach my $pf (@pf) {\r
232	next if $pf =~ m/^#/;\r
233	my @temp = split(/\\|/,$pf);\r
234	#??? @av = grep(!/^$temp[0]/, @av);\r
235	print "<tr><td valign='top'>" . join("</td><td valign='top'>",@temp) . "</td></tr>";\r
236	}\r
237	close(PF);\r
238	\r
239	print "</table>";\r
240	\r
241	&Header::closebox();\r
242	\r
243	&Header::closebigbox();\r
244	\r
245	&Header::closepage();\r
246	\r
247	sub downloadlist {\r
248	unless (-e "${General::swroot}/red/active") {\r
249	return 0;\r
250	}\r
251	\r
252	my $downloader = LWP::UserAgent->new;\r
253	$downloader->timeout(5);\r
254	\r
255	my %proxysettings=();\r
256	&General::readhash("${General::swroot}/proxy/settings", \%proxysettings);\r
257	\r
258	if ($_=$proxysettings{'UPSTREAM_PROXY'}) {\r
259	my ($peer, $peerport) = (/^(?:[a-zA-Z ]+\:\/\/)?(?:[A-Za-z0-9\_\.\-]?(?:\:[A-Za-z0-9\_\.\-]?)?\@)?([a-zA-Z0-9\.\_\-]?)(?:\:([0-9]{1,5}))?(?:\/.?)?$/);\r
260	if ($proxysettings{'UPSTREAM_USER'}) {\r
261	$downloader->proxy("http","http://$proxysettings{'UPSTREAM_USER'}:$proxysettings{'UPSTREAM_PASSWORD'}@"."$peer:$peerport/");\r
262	} else {\r
263	$downloader->proxy("http","http://$peer:$peerport/");\r
264	}\r
265	}\r
266	\r
267	return $downloader->get("http://www.ipcop.org/patches/${General::version}", 'Cache-Control', 'no-cache');\r
268	\r
269	}\r