path: root/dh_smf

#!/usr/bin/perl -w

=head1 NAME

dh_smf - install SMF services into package build directories

=cut

use strict;
use Debian::Debhelper::Dh_Lib;
use File::Find;
use XML::Simple;
use Data::Dumper;    # debug

=head1 SYNOPSIS

B<dh_smf> [S<I<debhelper options>>] [B<--name=>I<name>] [B<-n>] [B<-R>] [B<-r>]

=head1 DESCRIPTION

B<dh_smf> is a debhelper program that is responsible for installing
SMF manifests and scripts with associated defaults files.

It also automatically generates the F<postinst> and F<postrm> and F<prerm>
commands needed to manage SMF services.

=head1 FILES

=over 4

=item debian/I<package>.smf/

If this directory exists, it is installed as lib/svc/ in the package
build directory.

=item debian/I<package>.default

If this exists, it is installed into etc/default/I<package> in the package
build directory.

=back

=head1 OPTIONS

=over 4

=item B<-n>, B<--noscripts>

Do not modify F<postinst>/F<postrm>/F<prerm> scripts.

=item B<-o>, B<--onlyscripts>

Only modify F<postinst>/F<postrm>/F<prerm> scripts, do not actually install
any files. May be useful if the file is shipped and/or installed by upstream
in a way that doesn't make it easy to let B<dh_smf> find it.

=back

=head1 NOTES

Note that this command is not idempotent. L<dh_prep(1)> should be called
between invocations of this command. Otherwise, it may cause multiple
instances of the same text to be added to maintainer scripts.

=cut

# Same as pkgfile in /usr/share/perl5/Debian/Debhelper/Dh_Lib.pm,
# but -f => -d
sub pkgdir {
    my $package  = shift;
    my $filename = shift;

    if ( defined $dh{NAME} ) {
        $filename = "$dh{NAME}.$filename";
    }

    # First, check for files ending in buildarch and buildos.
    my $match;
    foreach my $file ( glob("debian/$package.$filename.*") ) {
        next if !-d $file;
        next if $dh{IGNORE} && exists $dh{IGNORE}->{$file};
        if ( $file eq "debian/$package.$filename." . buildarch() ) {
            $match = $file;

            # buildarch files are used in preference to buildos files.
            last;
        }
        elsif ( $file eq "debian/$package.$filename." . buildos() ) {
            $match = $file;
        }
    }
    return $match if defined $match;

    my @try = ("debian/$package.$filename");
    if ( $package eq $dh{MAINPACKAGE} ) {
        push @try, "debian/$filename";
    }

    foreach my $file (@try) {
        if ( -d $file
            && ( !$dh{IGNORE} || !exists $dh{IGNORE}->{$file} ) )
        {
            return $file;
        }

    }

    return "";
}

init( options => {} );

foreach my $package ( @{ $dh{DOPACKAGES} } ) {
    my $tmp = tmpdir($package);

    # Copy manifests and methods into package directory
    my $smf = pkgdir( $package, 'smf' );
    if ( $smf ne '' && !$dh{'ONLYSCRIPTS'} ) {
        my $svcdir = "$tmp/lib/svc";
        if ( !-d "$svcdir" ) {
            doit( 'install', '-d', "$svcdir" );
        }
        my $cp_v = $dh{'VERSION'} ? '-v' : '';
        complex_doit("cp -a $cp_v -f $smf/* $svcdir/");
    }

    # Get a list of all manifests in package
    my @manifests = ();
    find(
        {
            wanted => sub {
                -f $_ && /^.*\.xml\z/s && push @manifests, $File::Find::name;
            },
            no_chdir => 1,
        },
        "$tmp/lib/svc/manifest"
    );

    next unless @manifests;

    # TODO: validate XML?

    # Read all services from all manifests:
    my @services = ();
    foreach my $manifest (@manifests) {
        my $xml = XMLin( $manifest,
            ForceArray =>
              [qw/instance dependency exec_method propval property_group/] );

        my $service_base = $xml->{'service'}->{'name'};
        if ( exists $xml->{'service'}->{'create_default_instance'} ) {
            push @services,
              {
                'name' => "svc:/$service_base:default",
                'enabled' =>
                  $xml->{'service'}->{'create_default_instance'}->{'enabled'},
                'exec_method' => $xml->{'service'}->{'exec_method'},
                'duration' =>
                  $xml->{'service'}->{'property_group'}->{'startd'}->{'propval'}
                  ->{'duration'}->{'value'} // 'contract',
                'upgrade' =>
                  $xml->{'service'}->{'property_group'}->{'package'}
                  ->{'propval'}->{'upgrade'}->{'value'} // 'stop',
              };
        }
        if ( exists $xml->{'service'}->{'instance'} ) {
            while ( my ( $k, $v ) = each %{ $xml->{'service'}->{'instance'} } )
            {
                push @services,
                  {
                    'name'        => "svc:/$service_base:$k",
                    'enabled'     => $v->{'enabled'},
                    'exec_method' => $v->{'exec_method'}
                      // $xml->{'service'}->{'exec_method'},
                    'duration' =>
                      $v->{'property_group'}->{'startd'}->{'propval'}
                      ->{'duration'}->{'value'}
                      // $xml->{'service'}->{'property_group'}->{'startd'}
                      ->{'propval'}->{'duration'}->{'value'} // 'contract',
                    'upgrade' =>
                      $v->{'property_group'}->{'package'}->{'propval'}
                      ->{'upgrade'}->{'value'} // 'stop',
                  };
            }
        }
    }

# Ignore milestones and dummy services. A milestone is usually a dummy service as well
    @services = grep {
             $_->{'name'} !~ /milestone\//
          && $_->{'exec_method'}->{'start'}->{'exec'} ne ':true'
    } @services;

    error("No SMF services found in @manifests") unless @services;

    if ( !$dh{NOSCRIPTS} ) {
        my @pkg_manifests = map { s!\Q$tmp\E/*!/!; $_ } @manifests;
        my @svcs = ();
        autoscript( $package, 'postinst', 'postinst-smf-import',
            "s|#MANIFESTS#|@pkg_manifests|" );

        my @daemons = grep { $_->{'duration'} ne 'transient' } @services;
        my @daemons_stop    = grep { $_->{'upgrade'} eq 'stop' } @daemons;
        my @daemons_restart = grep { $_->{'upgrade'} eq 'restart' } @daemons;
        my @daemons_refresh = grep { $_->{'upgrade'} eq 'refresh' } @daemons;
        if (@daemons_stop) {
            @svcs = map { $_->{'name'} } @daemons_stop;
            autoscript( $package, 'prerm', 'prerm-smf-stop',
                "s|#SERVICES#|@svcs|" );
            autoscript( $package, 'postinst', 'postinst-smf-start',
                "s|#SERVICES#|@svcs|" );
        }
        if (@daemons_restart) {
            @svcs = map { $_->{'name'} } @daemons_restart;
            autoscript( $package, 'postinst', 'postinst-smf-start',
                "s|#SERVICES#|@svcs|" );
        }
        if (@daemons_refresh) {
            @svcs = map { $_->{'name'} } @daemons_refresh;
            autoscript( $package, 'postinst', 'postinst-smf-refresh',
                "s|#SERVICES#|@svcs|" );
        }

        # Disable and delete services on removal.
        # Other services (upgrade=stop) are already disabled.
        my @services_nonstop = grep { $_->{'upgrade'} ne 'stop' } @services;
        if (@services_nonstop) {
            @svcs = map { $_->{'name'} } @services_nonstop;
            autoscript( $package, 'prerm', 'prerm-smf-stop-before-remove',
                "s|#SERVICES#|@svcs|" );
        }

        # Remove all services.
        @svcs = map { $_->{'name'} } @services;
        autoscript( $package, 'postrm', 'postrm-smf-delete',
            "s|#SERVICES#|@svcs|" );
    }
}

=head1 SEE ALSO

L<debhelper(7)>, L<dh_installinit(1)>, L<smf(5)>, L<svccfg(1M)>

This program is a part of debhelper.

=head1 AUTHORS

Joey Hess <joeyh@debian.org> (dh_installinit)

Steve Langasek <steve.langasek@canonical.com>

Michael Stapelberg <stapelberg@debian.org>

Igor Pashev <pashev.igor@gmail.com>

=cut