Mail::Toaster::FreeBSD - FreeBSD specific Mail::Toaster functions.

 Mail::Toaster 
 Mail::Toaster::Conf
 toaster.conf
 toaster-watcher.conf

 http://mail-toaster.org/
 http://www.tnpi.net/computing/freebsd/

package Mail::Toaster::FreeBSD;

use strict;
use warnings;

our $VERSION = '5.26';

use Cwd;
use Carp;
use File::Copy;
use Params::Validate qw( :all );

use vars qw($err);

use lib 'lib';
use Mail::Toaster 5.26;
my ($toaster, $log, $util, %std_opts );

sub new {
    my $class = shift;
    my %p     = validate( @_,
        {   'log' => { type => OBJECT  },
            fatal => { type => BOOLEAN, optional => 1, default => 1 },
            debug => { type => BOOLEAN, optional => 1 },
        }
    );

    $toaster = $log = $p{'log'};
    $util = $toaster->get_util;

    my $debug = $log->get_debug;  # inherit from our parent
    my $fatal = $log->get_fatal;
    $debug = $p{debug} if defined $p{debug};  # explicity overridden
    $fatal = $p{fatal} if defined $p{fatal};

    my $self = {
        'log' => $log,
        debug => $debug,
        fatal => $fatal,
    };
    bless $self, $class;

    # globally scoped hash, populated with defaults as requested by the caller
    %std_opts = (
        'test_ok' => { type => BOOLEAN, optional => 1 },
        'fatal'   => { type => BOOLEAN, optional => 1, default => $fatal },
        'debug'   => { type => BOOLEAN, optional => 1, default => $debug },
    );

    return $self;
}

sub drive_spin_down {
    my $self = shift;
    my %p = validate( @_, { 'drive' => SCALAR, %std_opts } );

    my $drive = $p{'drive'};
    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    return $p{'test_ok'} if defined $p{'test_ok'};

    #TODO: see if the drive exists!

    my $camcontrol = $util->find_bin( "camcontrol", %args) 
        or return $log->error( "couldn't find camcontrol", %args );

    print "spinning down backup drive $drive...";
    $util->syscmd( "$camcontrol stop $drive", %args );
    print "done.\n";
    return 1;
}

sub get_port_category {
    my $self = shift;
    my $port = shift or die "missing port in request\n";

    my ($path) = glob("/usr/ports/*/$port/distinfo");
    if ( ! $path ) {
        ($path) = glob("/usr/ports/*/$port/Makefile");
    };
#warn "path: $path\n";
    return if ! $path;
    my @bits = split( '/', $path );
#warn "bits3: $bits[3]\n";
    return $bits[3];
}

sub get_version {
    my $self  = shift;
    my $debug = shift;

    my $uname = $util->find_bin( "uname", debug => 0 );
    print "found uname: $uname\n" if $debug;

    my $version = `$uname -r`;
    chomp $version;
    print "version is $version\n" if $debug;

    return $version;
}

sub install_port {
    my $self = shift;
    my $portname = shift or return $log->error("missing port/package name", fatal=>0);
    my %p    = validate(
        @_,
        {   dir      => { type => SCALAR, optional => 1 },
            category => { type => SCALAR|UNDEF, optional => 1 },
            check    => { type => SCALAR,  optional => 1 },
            flags    => { type => SCALAR,  optional => 1 },
            options  => { type => SCALAR,  optional => 1 },
            %std_opts,
        },
    );

    my $options = $p{options};
    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    my $make_defines = "";
    my @defs;

    return $p{test_ok} if defined $p{test_ok};

    my $check = $p{check} || $portname;
    return 1 if $self->is_port_installed( $check, debug=>1);

    my $port_dir = $p{dir} || $portname;
    $port_dir =~ s/::/-/g if $port_dir =~ /::/;

    my $start_directory = Cwd::getcwd();
		my $category = $p{category} || $self->get_port_category($portname) 
            or die "unable to find port directory for port $portname\n";

		my $path = "/usr/ports/$category/$port_dir";
		-d $path && chdir $path or croak "couldn't cd to $path: $!\n";

    $log->audit("install_port: installing $portname");

    # these are the "make -DWITH_OPTION" flags
    if ( $p{flags} ) {
        @defs = split( /,/, $p{flags} );
        foreach my $def (@defs) {
            if ( $def =~ /=/ ) {             # DEFINE=VALUE format, use as is
                $make_defines .= " $def ";
            }
            else { 
                $make_defines .= " -D$def "; # otherwise, prepend the -D flag
            }
        }
    }

    if ($options) {
        $self->port_options( port => $portname, opts => $options );
    }

    if ( $portname eq "qmail" ) {
        $util->syscmd( "make clean && make $make_defines install && make clean");
    }
    elsif ( $portname eq "ezmlm-idx" ) {
        $util->syscmd( "make clean && make $make_defines install" );
        copy( "work/ezmlm-0.53/ezmlmrc", "/usr/local/bin" );
        $util->syscmd( "make clean" );
    }
    else {

        # reset our PATH, to make sure we use our system supplied tools
        $ENV{PATH}
            = "/bin:/sbin:/usr/bin:/usr/sbin:/usr/local/bin:/usr/local/sbin";

        # the vast majority of ports work great this way
        print "running: make $make_defines install clean\n";
        system "make clean";
        system "make $make_defines";
        system "make $make_defines install";
        system "make clean";
    }

    # return to our original working directory
    chdir($start_directory);

    return 1 if $self->is_port_installed( $check, debug=>1 );

    $log->audit( "install_port: $portname install, FAILED" );
    $self->install_port_try_manual( $portname, $path );

    if ( $portname =~ /\Ap5\-(.*)\z/ ) {
        my $p_name = $1;
        $p_name =~ s/\-/::/g;

        print <<"EO_PERL_MODULE_MANUAL";
Since it was a perl module that failed to install,  you could also try
manually installing via CPAN. Try something like this:

       perl -MCPAN -e 'install $p_name'

EO_PERL_MODULE_MANUAL
    };

    return $log->error( "Install of $portname failed. Please fix and try again.", %args);
}

sub is_port_installed {
    my $self = shift;
    my $port = shift or return $log->error("missing port/package name", fatal=>0);
    my %p    = validate(
        @_,
        {   'alt' => { type => SCALAR | UNDEF, optional => 1 },
            %std_opts,
        },
    );

    my $alt = $p{'alt'} || $port;

    my ( $r, @args );

    $log->audit( "  checking for port $port", debug=>0);

    return $p{'test_ok'} if defined $p{'test_ok'};

    my $pkg_info = $util->find_bin( 'pkg_info', debug => 0 );
    my @packages = `pkg_info`; chomp @packages;
    my @matches = grep {/^$port\-/} @packages;
    if ( scalar @matches == 0 ) { @matches = grep {/^$port/} @packages; };
    if ( scalar @matches == 0 ) { @matches = grep {/^$alt\-/ } @packages; };
    if ( scalar @matches == 0 ) { @matches = grep {/^$alt/ } @packages; };
    return if scalar @matches == 0; # no matches
    $toaster->audit( "WARN: found multiple matches for port $port",debug=>1)
        if scalar @matches > 1;

    my ($installed_as) = split(/\s/, $matches[0]);
    $toaster->audit( "found port $port installed as $installed_as",debug=>$p{debug} );
    return $installed_as;
}

sub install_portupgrade {
    my $self = shift;
    my %p = validate( @_, { %std_opts } );

    my $conf = $toaster->get_config;
    my %args = $toaster->get_std_args( %p );

    my $package = $conf->{'package_install_method'} || "packages";

    if ( defined $p{'test_ok'} ) { return $p{'test_ok'}; }

    # if we're running FreeBSD 6, try installing the package as it will do the
    # right thing. On older systems we want to install a (much newer) version
    # of portupgrade from ports

    if ( $self->get_version =~ m/\A6/ ) {
        $self->install_package( "portupgrade", %args );
    }

    if ( $package eq "packages" ) {
        $self->install_package( "ruby18_static",
            alt   => "ruby-1.8",
            %args,
        );
    }

    $self->install_port( port => "portupgrade", %args );

    return 1 if $self->is_port_installed( "portupgrade" );
    return;
}

sub install_package {
    my $self = shift;
    my $package = shift or die "missing package in request\n";
    my %p    = validate(
        @_,
        {   'alt'   => { type => SCALAR, optional => 1, },
            'url'   => { type => SCALAR, optional => 1, },
            %std_opts,
        },
    );

    my ( $alt, $pkg_url ) = ( $p{'alt'}, $p{'url'} );
    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    return $util->error("sorry, but I really need a package name!") if !$package;

    $log->audit("install_package: checking if $package is installed");

    return $p{'test_ok'} if defined $p{'test_ok'};

    return 1 if $self->is_port_installed( $package, alt => $alt, %args );

    print "install_package: installing $package....\n";
    $ENV{"PACKAGESITE"} = $pkg_url if $pkg_url;

    my $pkg_add = $util->find_bin( "pkg_add", %args );
    return $log->error( "couldn't find pkg_add, giving up.",fatal=>0)
        if ( !$pkg_add || !-x $pkg_add );

    my $r2 = $util->syscmd( "$pkg_add -r $package", debug => 0 );

    if   ( !$r2 ) { print "\t pkg_add failed\t "; }
    else          { print "\t pkg_add success\t " };

    unless ( $self->is_port_installed( $package, alt => $alt, %args )) {
        print "Failure #1, trying alternate package site.\n";
        $ENV{"PACKAGEROOT"} = "ftp://ftp2.freebsd.org";
        $util->syscmd( "$pkg_add -r $package", debug => 0 );

        unless ( $self->is_port_installed( $package, alt => $alt, %args,)) {
            print "Failure #2, trying alternate package site.\n";
            $ENV{"PACKAGEROOT"} = "ftp://ftp3.freebsd.org";
            $util->syscmd( "$pkg_add -r $package", debug => 0 );

            unless ( $self->is_port_installed( $package, alt => $alt, %args,)) {
                print "Failure #3, trying alternate package site.\n";
                $ENV{"PACKAGEROOT"} = "ftp://ftp4.freebsd.org";
                $util->syscmd( "$pkg_add -r $package", debug => 0 );
            }
        }
    }

    my $r = $self->is_port_installed( $package, alt => $alt, %args );
    if ( ! $r ) {
        carp "  : Failed again! Sorry, I can't install the package $package!\n";
        return;
    }

    return $r;
}

sub install_port_try_manual {
    my ($self, $portname, $path ) = @_;
    print <<"EO_PORT_TRY_MANUAL";

    Automatic installation of port $portname failed! You can try to install $portname manually
using the following commands:

        cd $path
        make
        make install clean

    If that does not work, make sure your ports tree is up to date and try again. You
can also check out the "Dealing With Broken Ports" article on the FreeBSD web site:

        http://www.freebsd.org/doc/en_US.ISO8859-1/books/handbook/ports-broken.html

If none of those options work out, there may be something "unique" about your system
that is the source of the  problem, or the port my just be broken. You have several
choices for proceeding. You can:

    a. Wait until the port is fixed
    b. Try fixing it yourself
    c. Get someone else to fix it

EO_PORT_TRY_MANUAL
}

sub port_options {
    my $self = shift;
    my %p = validate(
        @_,
        {   port  => SCALAR,
            opts  => SCALAR,
            %std_opts,
        },
    );

    my ( $port, $opts ) = ( $p{port}, $p{opts} );
    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    return $p{test_ok} if defined $p{test_ok};

    if ( !-d "/var/db/ports/$port" ) {
        $util->mkdir_system( dir => "/var/db/ports/$port", %args,);
    }

    $util->file_write( "/var/db/ports/$port/options", lines => [$opts], %args );
}

sub update_ports {
    my $self = shift;
    my %p = validate( @_, { %std_opts, } );
    my %args = $toaster->get_std_args( %p );

    return $p{test_ok} if defined $p{test_ok};

    return $log->error( "you do not have write permission to /usr/ports.",%args) if ! $util->is_writable('/usr/ports', %args);

    my $conf = $toaster->get_config;
    my $supfile = $conf->{'cvsup_supfile_ports'} || "portsnap";

    return $self->portsnap( %args);

    return 1;
}

sub portsnap {
    my $self = shift;
    my %p    = validate( @_, { %std_opts, },);

    my %args = ( debug => $p{debug}, fatal => $p{fatal} );

    return $p{'test_ok'} if defined $p{'test_ok'};

    # should be installed already on FreeBSD 5.5 and 6.x
    my $portsnap = $util->find_bin( "portsnap", fatal => 0 );
    my $ps_conf = "/etc/portsnap.conf";

    unless ( $portsnap && -x $portsnap ) {
        $self->install_port( "portsnap" );

        $ps_conf = '/usr/local/etc/portsnap.conf';
        if ( !-e $ps_conf ) {
            if ( -e "$ps_conf.sample" ) {
                copy( "$ps_conf.sample", $ps_conf );
            }
            else {
                warn "WARNING: portsnap configuration file is missing!\n";
            }
        }

        $portsnap = $util->find_bin( "portsnap", fatal => 0 );
        unless ( $portsnap && -x $portsnap ) {
            return $util->error(
                "portsnap is not installed (correctly). I cannot go on!");
        }
    }

    if ( !-e $ps_conf ) {
        $portsnap .= " -s portsnap.freebsd.org";
    }

    # grabs the latest updates from the portsnap servers
    system $portsnap, 'fetch';

    if ( !-e "/usr/ports/.portsnap.INDEX" ) {
        print "\a
        COFFEE BREAK TIME: this step will take a while, dependent on how fast your
        disks are. After this initial extract, portsnap updates are much quicker than
        doing a cvsup and require less bandwidth (good for you, and the FreeBSD 
        servers). Please be patient.\n\n";
        sleep 2;
        system $portsnap, "extract";
    }
    else {
        system $portsnap, "update";
    }

    return 1;
}

sub conf_check {
    my $self = shift;
    my %p = validate(
        @_,
        {   'check' => { type => SCALAR, },
            'line'  => { type => SCALAR, },
            'file'  => { type => SCALAR,  optional => 1, },
            %std_opts,
        },
    );

    my %args = $log->get_std_args( %p );
    my $check = $p{check};
    my $line  = $p{line};
    my $file  = $p{file} || "/etc/rc.conf";

    return $p{'test_ok'} if defined $p{'test_ok'};

    my $changes;
    my @lines;
    @lines = $util->file_read( $file ) if -f $file;
    foreach ( @lines ) {
        next if $_ !~ /^$check\=/;
        return $log->audit("conf_check: no change to $check") if $_ eq $line;
        $log->audit("\tchanged:\n$_\n\tto:\n$line\n" );
        $_ = $line;
        $changes++;
    };
    if ( $changes ) {
        return $util->file_write( $file, lines => \@lines, %args );
    };

    return $util->file_write( $file, append => 1, lines => [$line], %args );
}

1;
__END__