#!/usr/bin/perl -w

#####
# jh                                                                    26jan97
#
# maninstall
# maninstall Maninstall is a Perl script written to make the installation of
#            man pages somewhat easier. The main reason to write it has been
#            the wish to make the installation more coherent than it is possible
#            by using the installation procedures provided by the makefiles that
#            come with different software packages.
#
#	     Via maninstall man pages can be installed as belonging to a given
#            owner and group and with given permissions. It can eliminate .so
#            requests by creating hard or symbolic links, handles recursive
#            .so requests and as an option will install the man pages compressed
#            by GNU gzip too.
#
#            There is a bunch of options, of which not all have to be provided,
#            since default values are used for the more important of them.
#
#            --prefix           default value /usr/share/man
#	     --uid              default value            man
#            --gid              default value            adm
#            --perm             default value           0444
#            --suffix		-
#            --link		-
#            --symbolic		-
#	     --compress		-
#	     --verbose		-
#	     --version		-
#	     --help		-
#
#	     As an example how to use maninstall assume the following files
#            are given ...
#            ./man1/pathto.1
#            ./man1/uupath.1
#	     ./man1/uuwho.1
#	     ./man5/smailconf.5
#	     ./man5/smaildrct.5
#	     ./man5/smailmeth.5
#	     ./man5/smailqual.5
#	     ./man5/smailrtrs.5
#	     ./man5/smailrtry.5
#	     ./man5/smailtrns.5
#
#            ... then maninstall --prefix=/usr/share/man \
#                                --uid=man               \
#                                --gid=adm               \
#                                --perm=0644             \
#                                --link                  \
#                                --compress              \
#                                --suffix=smail          \
#                                --verbose
#
#            ... would install these pages as ...
#
#            /usr/share/man/man1/pathto.1smail.gz
#            /usr/share/man/man1/uupath.1smail.gz
#            /usr/share/man/man1/uuwho.1smail.gz
#	     /usr/share/man/man5/smail.5smail.gz
#	     /usr/share/man/man5/smailconf.5smail.gz
#	     /usr/share/man/man5/smaildrct.5smail.gz
#	     /usr/share/man/man5/smailmeth.5smail.gz
#	     /usr/share/man/man5/smailqual.5smail.gz
#	     /usr/share/man/man5/smailrtrs.5smail.gz
#	     /usr/share/man/man5/smailrtry.5smail.gz
#	     /usr/share/man/man5/smailtrns.5smail.gz
#
#            ... and uupath.1smail.gz would be a link to pathto.1smail.gz.
#
# jh                                                                    12oct97
#
#            Handle .so requests to man pages with a suffix like
#	     .so man8/smail.8smail and support symbolic links.
#
# jh                                                                    22oct97
#
#            Use File::Copy instead of system() and cp.
#
# jh                                                                    30oct97
#
#            See FHS version 2.0 and use /usr/share/man instead of /usr/man.
#
# jh                                                                    08feb98
#
#            Added the new option --suffix, such that man pages can be installed
#            with a given suffix, ignore comment lines and handle absolute paths
#	     in .so requests too.
#
#            Changed some regular expressions in the hope to make them a little
#            bit faster.
#
# jh                                                                    09feb98
#
#            Translated the script header ... I gave my best at least ;-)
#            Known bugs: * with --suffix maninstall renames the original files
#                          before installing them to make things easier.
#
# jh                                                                    10feb98
#
#            Fixed a stupid bug in the rm() function.
#            
#            (c) juergen heinzl, unicorn@noris.de
#
#	     This code is distributed under the terms of the GPL.

require 5.003;
use     Getopt::Long;
use       File::Copy;

$MSGUSE   = 'maninstall [--prefix=<prefix>][--suffix=<suffix>][--uid=<uid>][--gid=<gid>][--perm=<perm>][--link][--symbolic][--compress][--verbose][--help][--version]';
$MSGVER   = 'version 1.04.2, Juergen Heinzl, unicorn@noris.de';
@MANSECT  = ( 'man1',
              'man2',
              'man3',
              'man4',
              'man5',
              'man6',
              'man7',
              'man8' );

#####
# einige konstanten; evtl. anpassen.
$opt_uid      = 'man';
$opt_gid      = 'adm';
$opt_perm     = '0444';
$opt_prefix   = '/usr/share/man';
$opt_suffix   =     '';
$opt_link     =  undef;
$opt_symbolic =  undef;
$opt_compress =  undef;
$opt_verbose  =  undef;
$opt_version  =  undef;
$opt_help     =  undef;

$result = GetOptions ( 'uid=s'    => \$opt_uid     ,
                       'gid=s'    => \$opt_gid     ,
                       'perm=i'   => \$opt_perm    ,
                       'prefix=s' => \$opt_prefix  ,
                       'suffix=s' => \$opt_suffix  ,
                       'link'     => \$opt_link    ,
                       'symbolic' => \$opt_symbolic,
                       'compress' => \$opt_compress,
                       'verbose'  => \$opt_verbose ,
                       'version'  => \$opt_version ,
                       'help'     => \$opt_help    );

if( 1 == $result ) {
    if( defined($opt_help) || defined($opt_version) ) {
        &msg( defined($opt_help) ? $MSGUSE : $MSGVER );
    } else {
        my $mansect;
        my @mansect;

        #####
        # einige pruefungen bevor losgerannt wird.
        &fail ( "gid    $opt_gid does not exist" ) if not  &GidOkay;
        &fail ( "uid    $opt_uid does not exist" ) if not  &UidOkay;
        &fail ( "perm   $opt_perm invalid"       ) if not &PermOkay;
        &fail ( "prefix $opt_prefix invalid"     ) if not &PrefOkay;
        &fail ( "suffix $opt_suffix invalid"     ) if not &SuffOkay;

        foreach $mansect ( @MANSECT ) {
                if( opendir ( MANSECT, $mansect ) ) {
                    @mansect = grep( ! -d && m/\w+\.\d\w*(?:($opt_suffix)?)$/o, readdir( MANSECT ) );
                    closedir( MANSECT );

                    if( @mansect ) {
                        if( $opt_verbose ) {
                            &msg( "install manual pages of section $mansect" );
                        }

                        #####
                        # erstmal die alten manual seiten loeschen; geht spaeter
                        # was schief sind die wenigstens auch nicht mehr da 8->
                        &rm ( $mansect, @mansect );
                        
                        #####
                        # statt n abfragen benenne ich mal die orginal manual
			# seiten einfach um, wenn ein suffix drangehaengt werden
			# soll, also alle smail manual seiten als 1smail etc.
			# installieren als beispiel.
                        if( $opt_suffix ) {
                            chdir( $mansect ) || &fail( "cannot chdir to $mansect - error $!" );
                            map {
                                  if( ! m/.*(?:$opt_suffix)$/o ) {
                                      if( ! rename( $_, $_ . $opt_suffix ) ) {
                                            &fail( "cannot rename $_ - error $!" );
                                      }
                                      $_ .= $opt_suffix;
                                  }
                            } @mansect;
                            chdir( '..'     ) || &fail( "cannot chdir to .. - error $!" );
                        }
                        
                        #####
                        # okay, jetzt die neuen manual seiten einspielen.
                        &add( $mansect, @mansect );
                    }
                }
        }
    }
  exit(0);
}


#####
# GidOkay()
# GidOkay() prueft ob die gruppe opt_gid existiert.
sub GidOkay {
    my $g;
    my $success;

    if( $success = defined( $g = getgrnam( $opt_gid ) ) ) {
        $opt_gid = $g;
    }

    $success;
}


#####
# UidOkay()
# UidOkay() prueft ob der user opt_uid eintrag existiert.
sub UidOkay {
    my $u;
    my $success;
    
    if( $success = defined( $u = getpwnam( $opt_uid ) ) ) {
        $opt_uid = $u;
    }

    $success;
}


#####
# PermOkay
# PermOkay prueft ob die uebergebenen permissions korrekt sind.
sub PermOkay {
    my $success = 0;

    $_ = $opt_perm;
    if( m/^[0-7]{1,4}$/o ) {
        if( 4 != length($_) || m/^0/o ) {
            $success = 1;
        }
    }

  $success;
}


#####
# PrefOkay
# PrefOkay prueft ob der angegebenen zielpfad fuer die installation
#          existiert.
sub PrefOkay {
    my $success = 1;

    if( -d $opt_prefix && -w $opt_prefix ) {
        my $mansect;
        my $manpath;

        foreach $mansect ( @MANSECT ) {
            $manpath = join( '/', $opt_prefix, $mansect );

            if( -e $manpath ) {
                if( ! -w $opt_prefix ) {
                    $success = 0; last;
                }
            }
        }
    } else {
        $success = 0;
    }
  $success;
}



#####
# SuffOkay
# SuffOkay prueft ob das angegebene suffix auch wirklicn nur aus
#          alphanumerischen zeichen besteht.
sub SuffOkay {
    my $success = 1;
    
    if( $opt_suffix && $opt_suffix =~ /\W+/o ) {
        $success = 0;
    }
    
    $success;
}



#####
# rm
# rm loescht alle manual seiten die neu installiert werden.
sub rm {
    my( $mansect, @mansect ) = @_;
    my  $manpage;
    my  $manpath;

    $manpath = join( '/', $opt_prefix, $mansect );
    if( -d $manpath ) {
        my @manpagetotest;

        #####
        # es ist moeglich, dass neue manual seiten mit suffix installiert
        # werden sollen, alte aber noch ohne da sind, daher auf alle
        # moeglichen kombinationen pruefen, also auch komprimiert, unkomprimiert
        # und so weiter.
        foreach $manpage ( @mansect ) {
                $manpagetotest[0] = join( '/', $manpath, $manpage                     );
                $manpagetotest[1] = join( '/', $manpath, $manpage,              '.gz' );
                $manpagetotest[2] = join( '/', $manpath, $manpage, $opt_suffix        );
                $manpagetotest[3] = join( '/', $manpath, $manpage, $opt_suffix, '.gz' );
            
                foreach $manpage ( @manpagetotest ) {
                        if( -e $manpage ) {
                            if( 0 == unlink( $manpage ) ) {
                                &fail( "cannot unlink $manpage - error $!" );
                            } else {
                                if( $opt_verbose ) {
                                    &msg( "manpage $manpage removed" );
                                }
                            }
                            last;
                        }
                }
        }
    } else {
        &fail( "$manpath not there and cannot create either - error $!" );
    }
}


#####
# add
# add installiert alle manual seiten einer man section.
sub add {
    my( $mansect, @manpage ) = @_;
    my  $manpage;
    my  $manpath;

    $manpath = join( '/', $opt_prefix, $mansect );
    if( chdir( $mansect ) ) {
        my $umask = umask();

        umask( 0777 & ~oct($opt_perm) );

        #####
        # sollen links verwendet werden, so muss evtl. eine manual seite ausser
        # reihe installiert werden, so das der link anlegbar ist.
        # eine solch installierte manual seite wird dann aus der tabelle der
        # noch zu installierenden entfernt.
        #
        # es wuerde sonst evtl. versucht spaeter nocheinmal zu installieren, was
        # mit einer permission von 0444 probleme gibt.
        #
        # jedesmal auf vorhanden sein testen duerfte wg. laenger dauern, da
        # jedesmal ein stat() aufruf erfolgen muss.
        if( $opt_link ) {
            my $size;
            my $offs;

            $offs = 0;
            $size = @manpage;
            while( $offs < $size ) {
                   $manpage = $manpage[$offs++];
                   if( open( MANPAGE, $manpage ) ) {
                       if( $opt_compress ) {
                           while( <MANPAGE> ) {
                                  #####
                                  # kommentarzeilen ueberspringen.
                                  next if m/^\.\\\"/o;

                                  #####
                                  # pruefen, ob ein .so request vorliegt. da es moeglich
                                  # ist, dass nicht .so man1/pathto.1smail sondern sowas
                                  # wie .so /usr/share/man/man1/pathto.1smail dasteht
                                  # muss evtl. sowas uebersprungen werden.
                                  if( m/^\.so\s(?:[\w\/]*)$mansect\/(\w*\.\d\w*)\s*$/ ) {
                                      my $mansoelimpage;
                                      my $mancreatepage;

                                      $mansoelimpage = &soelim( $1, $mansect );
                                      $mansoelimpage = join( '/', $manpath, $mansoelimpage ) . '.gz';
                                      $mancreatepage = join( '/', $manpath, $manpage       ) . '.gz';

                                      #####
                                      # testen ob es die referenzierte seite schon
                                      # gibt und wenn nicht einfach installieren
                                      # und aus @manpage entfernen.
                                      if( -e $mansoelimpage ) {
                                          &ln( $mansoelimpage, $mancreatepage );
                                      } else {
                                          &pk   (             $1, $mansoelimpage );
                                          &ln   ( $mansoelimpage, $mancreatepage );
                                          &lfind(  \@manpage, $1, \$size         );

                                          if( $opt_verbose ) {
                                              &msg( "installed $1" );
                                          }
                                      }
                                  } else {
                                      &pk( $manpage, join( '/', $manpath, $manpage . '.gz' ) );
                                  }
                             last;
                           }
                           close( MANPAGE );
                       } else {
                           while( <MANPAGE> ) {
                                  #####
                                  # kommentarzeilen ueberspringen.
                                  next if m/^\.\\\"/o;

                                  #####
                                  # pruefen, ob ein .so request vorliegt. da es moeglich
                                  # ist, dass nicht .so man1/pathto.1smail sondern sowas
                                  # wie .so /usr/share/man/man1/pathto.1smail dasteht
                                  # muss evtl. sowas uebersprungen werden.
                                  if( m/^\.so\s(?:[\w\/]*)$mansect\/(\w*\.\d\w*)\s*$/ ) {
                                      my $mansoelimpage;
                                      my $mancreatepage;

                                      $mansoelimpage = &soelim( $1, $mansect );
                                      $mansoelimpage = join( '/', $manpath, $mansoelimpage );
                                      $mancreatepage = join( '/', $manpath, $manpage       );

                                      if( -e $mansoelimpage ) {
                                          &ln( $mansoelimpage, $mancreatepage );
                                      } else {
                                          &cp   (             $1, $mansoelimpage );
                                          &ln   ( $mansoelimpage, $mancreatepage );
                                          &lfind(  \@manpage, $1, \$size         );

                                          if( $opt_verbose ) {
                                              &msg( "installed $1" );
                                          }
                                      }
                                  } else {
                                    &cp( $manpage, join( '/', $manpath, $manpage . '.gz' ) );
                                }
                             last;
                           }
                           close( MANPAGE );
                       }

                     if( $opt_verbose ) {
                         &msg( "installed $manpage" );
                     }
                   } else {
                     &fail( "cannot open $manpage - error $!" );
                   }
            }
        } else {
            foreach $manpage ( @manpage ) {
                    if( $opt_compress ) {
                        &pk( $manpage, join( '/', $manpath, $manpage . '.gz' ) );
                    } else {
                        &cp( $manpage, join( '/', $manpath, $manpage         ) );
                    }
            }
        }
        
      umask( $umask );
      chdir( '..' ) || &fail( "cannot chdir to .. - error $!" );
    } else {
      &fail( "cannot chdir to $mansect - error $!" );
    }
}




#####
# soelim
# soelim loest referenzen aus wobei auch mehrfach geschachtelte .so requests
#        korrekt aufgeloest werden.
#        sollte also in einer seite nur ein .so request auf eine seite stehen,
#        welche nur einen .so request enthaelt und so weiter wird soelim()
#        solange aufgerufen, bis die eigentliche manual seite bekannt ist.
sub soelim {
    my( $manpage, $mansect ) = @_;

    #####
    # die manual seite oeffen, lesen und nach .so requests suchen.
    if( open( MANPAGE, $manpage ) ) {
        while (<MANPAGE>) {
               next if m/^\.\\\"/o;

               if( m/^\.so\s(?:[\w\/]*)$mansect\/(\w*\.\d\w*)\s*$/ ) {
                   close( MANPAGE );

                   #####
                   # es ist moeglich, dass eine mit .so eingebundene
                   # seite wiederum eine andere referenziert, also
                   # rekursiv durchlaufen.
                   return( &soelim( $1, $mansect ) );
               }
        }

        close( MANPAGE );
    } else {
        &fail( "cannot open $manpage - error $!" );
    }

    $manpage;
}


#####
# lfind
# lfind entfernt einen eintrag aus einer tabelle.
sub lfind {
    my ( $tbl, $string, $tblsize ) = @_;
    my   $i;

    $i = 0;
    while( $tbl->[$i] ne $string ) {
           $i++;
    }

    splice( @$tbl, $i, 1 ); $$tblsize -= 1;
}


#####
# ln
# ln erzeugt einen link auf eine manual seite.
sub ln {
    my( $from, $to ) = @_;

    if( defined( $opt_symbolic ) ) {
        if( 0 == symlink( $from, $to ) ) {
            &fail( "cannot create symbolic link from $from to $to - error $!" );
        }
    } else {
        if( 0 == link( $from, $to ) ) {
            &fail( "cannot create link from $from to $to - error $!" );
        }
    }
}


#####
# cp
# cp kopiert eine manual seite.
sub cp {
    my( $from, $to ) = @_;

    if( copy( $from, $to ) ) {
        chown( $opt_uid, $opt_gid, $to );
    } else {
        &fail( "cannot copy $from to create $to" );
    }
    
}


#####
# pk
# pk installiert eine gepackte manual seite ueber einen gzip aufruf.
sub pk {
    my( $from, $to ) = @_;

    if( system( "gzip -c -f -9 $from > $to" ) ) {
        &fail( "cannot compress $from to create $to" );
    } else {
        chown( $opt_uid, $opt_gid, $to );
    }
}


#####
# msg
# msg gibt eine meldung aus.
sub msg {
    print $0," : ",@_,"\n";
}


#####
# fail
# fail gibt eine meldung auf stderr aus und beendet das programm.
sub fail {
    print STDERR $0," : ",$_[0], "\n"; exit(1);
}
