software/freebsd-lib.pl

   1 # bsd-lib.pl
   2 # Functions for FreeBSD package management
   3
   4 use POSIX;
   5 chop($system_arch = `uname -m`);
   6 $package_dir = "/var/db/pkg";
   7
   8 sub list_package_system_commands
   9 {
  10 return ("pkg_info", "pkg_add");
  11 }
  12
  13 # list_packages([package]*)
  14 # Fills the array %packages with a list of all packages
  15 sub list_packages
  16 {
  17 local $i = 0;
  18 local $arg = @_ ? join(" ", map { quotemeta($_) } @_) : "-a";
  19 %packages = ( );
  20 &open_execute_command(PKGINFO, "pkg_info -I $arg", 1, 1);
  21 while(<PKGINFO>) {
  22         if (/^(\S+)\s+(.*)/) {
  23                 $packages{$i,'name'} = $1;
  24                 $packages{$i,'class'} = "";
  25                 $packages{$i,'desc'} = $2;
  26                 $i++;
  27                 }
  28         }
  29 close(PKGINFO);
  30 return $i;
  31 }
  32
  33 # package_info(package)
  34 # Returns an array of package information in the order
  35 #  name, class, description, arch, version, vendor, installtime
  36 sub package_info
  37 {
  38 local $qm = quotemeta($_[0]);
  39 local $out = &backquote_command("pkg_info $qm 2>&1", 1);
  40 return () if ($?);
  41 local @rv = ( $_[0] );
  42 push(@rv, "");
  43 push(@rv, $out =~ /Description:\n([\0-\177]*\S)/i ? $1 : $text{'bsd_unknown'});
  44 push(@rv, $system_arch);
  45 push(@rv, $_[0] =~ /-([^\-]+)$/ ? $1 : $text{'bsd_unknown'});
  46 push(@rv, "FreeBSD");
  47 local @st = stat(&translate_filename("$package_dir/$_[0]"));
  48 push(@rv, @st ? ctime($st[9]) : $text{'bsd_unknown'});
  49 return @rv;
  50 }
  51
  52 # check_files(package)
  53 # Fills in the %files array with information about the files belonging
  54 # to some package. Values in %files are  path type user group mode size error
  55 sub check_files
  56 {
  57 local $i = 0;
  58 local $file;
  59 local $qm = quotemeta($_[0]);
  60 &open_execute_command(PKGINFO, "pkg_info -L $qm", 1, 1);
  61 while($file = <PKGINFO>) {
  62         $file =~ s/\r|\n//g;
  63         next if ($file !~ /^\//);
  64         local $real = &translate_filename($file);
  65         local @st = stat($real);
  66         $files{$i,'path'} = $file;
  67         $files{$i,'type'} = -l $real ? 3 :
  68                             -d $real ? 1 : 0;
  69         $files{$i,'user'} = getpwuid($st[4]);
  70         $files{$i,'group'} = getgrgid($st[5]);
  71         $files{$i,'mode'} = sprintf "%o", $st[2] & 07777;
  72         $files{$i,'size'} = $st[7];
  73         $files{$i,'link'} = readlink($real);
  74         $i++;
  75         }
  76 return $i;
  77 }
  78
  79 # package_files(package)
  80 # Returns a list of all files in some package
  81 sub package_files
  82 {
  83 local ($pkg) = @_;
  84 local $qn = quotemeta($pkg);
  85 local @rv;
  86 &open_execute_command(RPM, "pkg_info -L $qn", 1, 1);
  87 while(<RPM>) {
  88         s/\r|\n//g;
  89         if (/^\//) {
  90                 push(@rv, $_);
  91                 }
  92         }
  93 close(RPM);
  94 return @rv;
  95 }
  96
  97 # installed_file(file)
  98 # Given a filename, fills %file with details of the given file and returns 1.
  99 # If the file is not known to the package system, returns 0
 100 # Usable values in %file are  path type user group mode size packages
 101 sub installed_file
 102 {
 103 local (%packages, $file, $i, @pkgin);
 104 local $n = &list_packages();
 105 for($i=0; $i<$n; $i++) {
 106         &open_execute_command(PKGINFO, "pkg_info -L $packages{$i,'name'}", 1, 1);
 107         while($file = <PKGINFO>) {
 108                 $file =~ s/\r|\n//g;
 109                 if ($file eq $_[0]) {
 110                         # found it
 111                         push(@pkgin, $packages{$i,'name'});
 112                         }
 113                 }
 114         close(PKGINFO);
 115         }
 116 if (@pkgin) {
 117         local $real = &translate_filename($_[0]);
 118         local @st = stat($real);
 119         $file{'path'} = $_[0];
 120         $file{'type'} = -l $real ? 3 :
 121                         -d $real ? 1 : 0;
 122         $file{'user'} = getpwuid($st[4]);
 123         $file{'group'} = getgrgid($st[5]);
 124         $file{'mode'} = sprintf "%o", $st[2] & 07777;
 125         $file{'size'} = $st[7];
 126         $file{'link'} = readlink($real);
 127         $file{'packages'} = join(" ", @pkgin);
 128         return 1;
 129         }
 130 else {
 131         return 0;
 132         }
 133 }
 134
 135 # is_package(file)
 136 sub is_package
 137 {
 138 local $real = &translate_filename($_[0]);
 139 local $qm = quotemeta($_[0]);
 140 if (-d $_[0]) {
 141         # A directory .. see if it contains any tgz files
 142         opendir(DIR, $real);
 143         local @list = grep { /\.tgz$/ || /\.tbz$/ } readdir(DIR);
 144         closedir(DIR);
 145         return @list ? 1 : 0;
 146         }
 147 elsif ($_[0] =~ /\*|\?/) {
 148         # a wildcard .. see what it matches
 149         local @list = glob($real);
 150         return @list ? 1 : 0;
 151         }
 152 else {
 153         # just a normal file - see if it is a package
 154         local $cmd;
 155         foreach $cmd ('gunzip', 'bunzip2') {
 156                 next if (!&has_command($cmd));
 157                 local ($desc, $contents);
 158                 &open_execute_command(TAR, "$cmd -c $qm | tar tf -", 1, 1);
 159                 while(<TAR>) {
 160                         $desc++ if (/^\+DESC/);
 161                         $contents++ if (/^\+CONTENTS/);
 162                         }
 163                 close(TAR);
 164                 return 1 if ($desc && $contents);
 165                 }
 166         return 0;
 167         }
 168 }
 169
 170 # file_packages(file)
 171 # Returns a list of all packages in the given file, in the form
 172 #  package description
 173 sub file_packages
 174 {
 175 local $real = &translate_filename($_[0]);
 176 local $qm = quotemeta($_[0]);
 177 if (-d $real) {
 178         # Scan directory for packages
 179         local ($f, @rv);
 180         opendir(DIR, $real);
 181         while($f = readdir(DIR)) {
 182                 if ($f =~ /\.tgz$/i || $f =~ /\.tbz$/i) {
 183                         local @pkg = &file_packages("$_[0]/$f");
 184                         push(@rv, @pkg);
 185                         }
 186                 }
 187         closedir(DIR);
 188         return @rv;
 189         }
 190 elsif ($real =~ /\*|\?/) {
 191         # Expand glob of packages
 192         # XXX won't work in translation
 193         local ($f, @rv);
 194         foreach $f (glob($real)) {
 195                 local @pkg = &file_packages($f);
 196                 push(@rv, @pkg);
 197                 }
 198         return @rv;
 199         }
 200 else {
 201         # Just one file
 202         local $cmd;
 203         foreach $cmd ('gunzip', 'bunzip2') {
 204                 next if (!&has_command($cmd));
 205                 local $temp = &transname();
 206                 &make_dir($temp, 0700);
 207                 local $rv = &execute_command("cd $temp && $cmd -c $qm | tar xf - +CONTENTS +COMMENT");
 208                 if ($rv) {
 209                         &unlink_file($temp);
 210                         next;
 211                         }
 212                 local ($comment, $name);
 213                 &open_readfile(COMMENT, "$temp/+COMMENT");
 214                 ($comment = <COMMENT>) =~ s/\r|\n//g;
 215                 close(COMMENT);
 216                 &open_readfile(CONTENTS, "$temp/+CONTENTS");
 217                 while(<CONTENTS>) {
 218                         $name = $1 if (/^\@name\s+(\S+)/);
 219                         }
 220                 close(CONTENTS);
 221                 &unlink_file($temp);
 222                 return ( "$name $comment" );
 223                 }
 224         return ( );
 225         }
 226 }
 227
 228 # install_options(file, package)
 229 # Outputs HTML for choosing install options
 230 sub install_options
 231 {
 232 print &ui_table_row($text{'bsd_scripts'},
 233         &ui_radio("scripts", 0, [ [ 0, $text{'yes'} ], [ 1, $text{'no'} ] ]));
 234
 235 print &ui_table_row($text{'bsd_force'},
 236         &ui_yesno_radio("force", 0));
 237 }
 238
 239 # install_package(file, package)
 240 # Installs the package in the given file, with options from %in
 241 sub install_package
 242 {
 243 local $in = $_[2] ? $_[2] : \%in;
 244 local $args = ($in->{"scripts"} ? " -I" : "").
 245               ($in->{"force"} ? " -f" : "");
 246 local $out = &backquote_logged("pkg_add $args $_[0] 2>&1");
 247 if ($?) {
 248         return "<pre>$out</pre>";
 249         }
 250 return undef;
 251 }
 252
 253 # install_packages(file, [&inputs])
 254 # Installs all the packages in the given file or glob
 255 sub install_packages
 256 {
 257 local $in = $_[2] ? $_[2] : \%in;
 258 local $args = ($in->{"scripts"} ? " -I" : "").
 259               ($in->{"force"} ? " -f" : "");
 260 local $file;
 261 if (-d $_[0]) {
 262         $file = "$_[0]/*.tgz";
 263         }
 264 else {
 265         $file = $_[0];
 266         }
 267 local $out = &backquote_logged("pkg_add $args $file 2>&1");
 268 if ($?) {
 269         return "<pre>$out</pre>";
 270         }
 271 return undef;
 272 }
 273
 274 # delete_package(package)
 275 # Totally remove some package
 276 sub delete_package
 277 {
 278 local $out = &backquote_logged("pkg_delete $_[0] 2>&1");
 279 if ($?) { return "<pre>$out</pre>"; }
 280 return undef;
 281 }
 282
 283 sub package_system
 284 {
 285 return &text('bsd_manager', "FreeBSD");
 286 }
 287
 288 sub package_help
 289 {
 290 return "pkg_add pkg_info pkg_delete";
 291 }
 292
 293 1;