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