1# emerge-lib.pl
2# Functions for gentoo package management
3
4chop($system_arch = `uname -m`);
5$pkg_dir = "/var/db/pkg";
6$portage_bin = "/usr/lib/portage/bin";
7$ENV{'TERM'} = "dumb";
8$package_list_binary = $package_list_command = "$portage_bin/pkglist";
9if (!-x $package_list_binary) {
10	$package_list_binary = &has_command("qlist");
11	$package_list_command = $package_list_binary." --nocolor -Iv";
12	}
13
14sub list_package_system_commands
15{
16return ( $package_list_binary || "pkglist" );
17}
18
19sub list_update_system_commands
20{
21return ("emerge");
22}
23
24# list_packages([package]*)
25# Fills the array %packages with all or listed packages
26sub list_packages
27{
28local $i = 0;
29%packages = ( );
30&open_execute_command(LIST, $package_list_command, 1, 1);
31while(<LIST>) {
32	if (/^([^\/]+)\/([^0-9]+)-(\d\S+)$/ &&
33	    !@_ || &indexof($2, @_) >= 0) {
34		$packages{$i,'name'} = $2;
35		$packages{$i,'class'} = $1;
36		$packages{$i,'version'} = $3;
37		&open_readfile(BUILD, "$pkg_dir/$1/$2-$3/$2-$3.ebuild");
38		while(<BUILD>) {
39			if (/DESCRIPTION="([^"]+)"/ || /DESCRIPTION='([^']+)'/) {
40				$packages{$i,'desc'} = $1;
41				last;
42				}
43			}
44		close(BUILD);
45		$i++;
46		}
47	}
48return $i;
49}
50
51# package_search(string, [allavailable])
52# Searches the package database for packages matching some string and puts
53# them into %packages
54sub package_search
55{
56local $n = 0;
57local $qm = quotemeta($_[0]);
58&open_execute_command(SEARCH, "emerge search $qm", 1, 1);
59while(<SEARCH>) {
60	s/\r|\n//g;
61	s/\033[^m]+m//g;
62	if (/^\*\s+([^\/]+)\/(\S+)/) {
63		$packages{$n,'name'} = $2;
64		$packages{$n,'class'} = $1;
65		$packages{$n,'missing'} = 0;
66		}
67	elsif (/version\s+Available:\s+(\S+)/i) {
68		$packages{$n,'version'} = $1;
69		}
70	elsif (/version\s+Installed:\s+\[\s+Not/i && !$_[1]) {
71		$packages{$n,'missing'} = 1;
72		}
73	elsif (/\s+Description:\s*(.*)/i) {
74		$packages{$n,'desc'} = $1;
75		local $nl = <SEARCH>;
76		chop($nl);
77		if ($nl =~ /\S/) {
78			$packages{$n,'desc'} .= " " if ($packages{$n,'desc'});
79			$packages{$n,'desc'} .= $nl;
80			}
81		$n++ if (!$packages{$n,'missing'} || $_[1]);
82		}
83	}
84close(SEARCH);
85return $n;
86}
87
88# package_info(package)
89# Returns an array of package information in the order
90#  name, class, description, arch, version, vendor, installtime
91sub package_info
92{
93local %packages;
94local $n = &list_packages($_[0]);
95$n || return ();
96local @st = stat("$pkg_dir/$packages{0,'class'}/$packages{0,'name'}-$packages{0,'version'}");
97return ( $packages{0,'name'}, $packages{0,'class'}, $packages{0,'desc'},
98	 $system_arch, $packages{0,'version'}, "Gentoo", &make_date($st[9]) );
99}
100
101# is_package(file)
102# Check if some file is a package file
103sub is_package
104{
105local $qm = quotemeta($_[0]);
106local $out = &backquote_command("emerge --pretend $qm 2>&1", 1);
107return $? ? 0 : 1;
108}
109
110# file_packages(file)
111# Returns a list of all packages in the given file, in the form
112#  package description
113sub file_packages
114{
115local @rv;
116local $qm = quotemeta($_[0]);
117&open_execute_command(EMERGE, "emerge --pretend $qm", 1, 1);
118while(<EMERGE>) {
119	s/\r|\n//g;
120	s/\033[^m]+m//g;
121	if (/\s+[NRU]\s+\]\s+([^\/]+)\/([^0-9]+)\-(\d\S+)/) {
122		push(@rv, $2);
123		}
124	}
125close(EMERGE);
126return @rv;
127}
128
129# install_options(file, package)
130# Outputs HTML for choosing install options for some package
131sub install_options
132{
133print &ui_table_row($text{'emerge_noreplace'},
134	&ui_radio("noreplace", 0, [ [ 0, $text{'yes'} ], [ 1, $text{'no'} ] ]));
135
136print &ui_table_row($text{'emerge_onlydeps'},
137	&ui_yesno_radio("onlydeps", 0));
138}
139
140$show_install_progress = 1;
141
142# install_package(file, package, [&inputs], [show])
143# Install the given package from the given file, using options from %in
144sub install_package
145{
146local $file = $_[0];
147local $in = $_[2] ? $_[2] : \%in;
148local $cmd = "emerge";
149$cmd .= " --noreplace" if ($in{'noreplace'});
150$cmd .= " --onlydeps" if ($in{'onlydeps'});
151$cmd .= " ".quotemeta($_[1]);
152if ($_[3]) {
153	&open_execute_command(OUT, "$cmd 2>&1", 1);
154	while(<OUT>) {
155		print &html_escape($_);
156		}
157	close(OUT);
158	return $? ? "Emerge error" : undef;
159	}
160else {
161	local $out;
162	&open_execute_command(OUT, "$cmd 2>&1 | tail -10", 1);
163	while(<OUT>) {
164		$out .= $_;
165		}
166	close(OUT);
167	return $? ? "<pre>$out</pre>" : undef;
168	}
169}
170
171# check_files(package)
172# Fills in the %files array with information about the files belonging
173# to some package. Values in %files are  path type user group size error
174sub check_files
175{
176local $i = 0;
177local (@files, %filesmap);
178local %packages;
179&list_packages($_[0]);
180&open_readfile(CONTENTS, "$pkg_dir/$packages{0,'class'}/$packages{0,'name'}-$packages{0,'version'}/CONTENTS");
181while(<CONTENTS>) {
182	s/\r|\n//g;
183	local @l = split(/\s+/);
184	$files{$i,'path'} = $l[1];
185	$files{$i,'type'} = $l[0] eq 'dir' ? 1 :
186			    $l[0] eq 'sym' ? 3 : 0;
187	local $real = &translate_filename($l[1]);
188	local @st = stat($real);
189	$files{$i,'user'} = getpwuid($st[4]);
190	$files{$i,'group'} = getgrgid($st[5]);
191	$files{$i,'size'} = $st[7];
192	if (!-e $l[1]) {
193		$files{$i,'error'} = "Does not exist";
194		}
195	elsif ($l[0] eq 'sym') {
196		$files{$i,'link'} = $l[3];
197		local $lnk = readlink($real);
198		$files{$i,'error'} = "Incorrect link" if ($l[3] ne $lnk);
199		}
200	elsif ($l[0] eq 'obj') {
201		push(@files, $l[1]);
202		$filesmap{$l[1]} = $i;
203		$files{$i,'md5'} = $l[2];
204		}
205	$i++;
206	}
207close(CONTENTS);
208if (&has_command("md5sum")) {
209	&open_execute_command(MD5, "md5sum ".join(" ", @files), 1, 1);
210	while(<MD5>) {
211		local ($md, $fn) = split(/\s+/);
212		local $n = $filesmap{$fn};
213		if ($md ne $files{$n,'md5'}) {
214			$files{$n,'error'} = "Checksum failed";
215			}
216		}
217	close(MD5);
218	}
219return $i;
220}
221
222# installed_file(file)
223# Given a filename, fills %file with details of the given file and returns 1.
224# If the file is not known to the package system, returns 0
225# Usable values in %file are  path type user group mode size packages
226sub installed_file
227{
228local ($cf, $type, @packs);
229local $real_dir = &translate_filename($pkg_dir);
230while($cf = <$real_dir/*/*/CONTENTS>) {
231	open(FILE, "<".$cf);
232	while(<FILE>) {
233		local @l = split(/\s+/);
234		if ($l[1] eq $_[0]) {
235			# Found it!
236			$cf =~ /\/([^0-9\/]+)-(\d[^\s\/]+)\/CONTENTS$/;
237			push(@packs, $1);
238			$type = $l[0] if (!$type);
239			}
240		}
241	close(FILE);
242	}
243return 0 if (!@packs);
244
245local $real = &translate_filename($_[0]);
246local @st = stat($real);
247$file{'packages'} = join(' ', @packs);
248$file{'path'} = $_[0];
249$file{'user'} = getpwuid($st[4]);
250$file{'group'} = getgrgid($st[5]);
251$file{'mode'} = sprintf "%o", $st[2] & 07777;
252$file{'size'} = $st[7];
253$file{'link'} = readlink($real);
254$file{'type'} = $type eq 'dir' ? 1 :
255		$type eq 'sym' ? 3 : 0;
256return 1;
257}
258
259
260
261# delete_package(package, [&options])
262# Attempt to remove some package
263sub delete_package
264{
265local $out = &backquote_logged("emerge -u ".quotemeta($_[0])." 2>&1");
266return $? ? "<pre>$out</pre>" : undef;
267}
268
269sub package_system
270{
271return "Gentoo Ebuild";
272}
273
274sub package_help
275{
276return "emerge";
277}
278
279$has_update_system = 1;
280
281# update_system_input()
282# Returns HTML for entering a package to install
283sub update_system_input
284{
285return "$text{'emerge_input'} <input name=update size=20> <input type=button onClick='window.ifield = form.update; chooser = window.open(\"../$module_name/emerge_find.cgi\", \"chooser\", \"toolbar=no,menubar=no,scrollbars=yes,width=600,height=500\")' value=\"$text{'emerge_find'}\">";
286}
287
288# update_system_install([package])
289# Install some package with emerge
290sub update_system_install
291{
292local $update = $_[0] || $in{'update'};
293local $cmd = "emerge ".quotemeta($update);
294local @rv;
295print "<b>",&text('emerge_install', "<tt>$cmd</tt>"),"</b><p>\n";
296print "<pre>\n";
297&additional_log('exec', undef, $cmd);
298&open_execute_command(CMD, "$cmd 2>&1 </dev/null", 1);
299while(<CMD>) {
300	print &html_escape($_);
301	if (/^\>\>\>\s+([^\/]+)\/([^0-9]+)-(\d\S+)\s+merged\./i) {
302		push(@rv, $2);
303		}
304	}
305close(CMD);
306print "</pre>\n";
307if ($?) { print "<b>$text{'emerge_failed'}</b><p>\n"; }
308else { print "<b>$text{'emerge_ok'}</b><p>\n"; }
309return @rv;
310}
311
3121;
313
314