#!/usr/bin/perl
# Copyright 1999 Stephen M. Benoit, Service Providers of America.
#  See notice at end of this file.
#
# Filename: archivegz
# Author: Stephen M. Benoit (benoits@servicepro.com)
# Created: Wed Apr 14 13:56:01 1999
#
# Various bug fixes, code and documentation improvements since then
# in 2000, 2001, 2021-2024.

# Specify command line options, and decode the command line.

use Getopt::Long;

$0 =~ s!.*/!!;

my $usage = "Usage:
  $0 [-fhmr] [-a dir] [-i file] [-n dir] [-t seconds] input

Options:
  -a dir      Directory to archive in instead of the default
  -f          Directory names will be flattened out
  -h          Print this help message
  -i file     Append one line to the index file for each article
              (Destination name, Message-ID, Subject)
  -m          Files are copied by making a link.  Not applicable, ignored
  -n dir      The news spool (source) directory (default=/var/spool/news/)
  -r          Suppress stderr redirection to /var/log/news/errlog
  -t seconds  Timeout that separates batches (default 10 seconds)
";

sub help {
    print $usage;
    exit(0);
}

my ($opt_a, $opt_f, $opt_h, $opt_i, $opt_m, $opt_n, $opt_r, $opt_t);
GetOptions(
    "-a=s" => \$opt_a,
    "-f"   => \$opt_f,
    "-h"   => \$opt_h,
    "-i=s" => \$opt_i,
    "-m"   => \$opt_m,
    "-n=s" => \$opt_n,
    "-r"   => \$opt_r,
    "-t=i" => \$opt_t,
) || die $usage;

$ignorecase = 0;
help() if defined($opt_h);

# --------------------------------------------------------------------

# --- constants and defaults ---
$NEWS_ROOT = "/var/spool/news/";
$NEWS_ERR = "/var/log/news/errlog";
$NEWS_ARCHIVE = $NEWS_ROOT . "news.archive/";
$timeout = 10;
if ($opt_t) { $timeout = $opt_t; }
if ($timeout < 1) { $timeout = 1; }

# --------------------------------------------------------------------

sub regexp_escape {
    my ($data) = @_;

    $data =~ s+\\+\\\\+gi;    # replace \ with \\
    $data =~ s+\/+\\\/+gi;    # replace / with \/

    $data =~ s/([\+\*\?\[\]\(\)\{\}\.\|])/\\$1/gi;    # replace +*?[](){}.|

    return $data;
}

sub fhbits {
    my (@fhlist) = split(' ', $_[0]);
    my ($bits);
    for (@fhlist) {
        vec($bits, fileno($_), 1) = 1;
    }
    return $bits;
}

sub timed_getline {
    my ($fileh, $timeout) = @_;

    local (*FILEH) = *$fileh{FILEHANDLE};    ## no critic (ProhibitLocalVars)

    my ($rin, $win, $ein);
    my ($rout, $wout, $eout);
    $rin = $win = $ein = '';
    $rin = fhbits('FILEH');
    $ein = $rin | $win;
    my ($nfound);
    my ($offset) = 0;
    my ($accum) = '';
    my ($done) = 0;
    my ($result);

    $nfound = select($rout = $rin, $wout = $win, $eout = $ein, $timeout);

    if ($nfound > 0) {

        # use sysread() to get characters up to end-of-line (incl.)
        while (!$done) {
            $result = sysread(FILEH, $accum, 1, $offset);
            if ($result <= 0) {
                $done = 1;
                return;
            }

            if (substr($accum, $offset, 1) eq "\n") {
                $done = 1;
            } else {
                $offset += $result;
            }
        }
    }
    return $accum;
}

# --------------------------------------------------------------------

# --- source spool directory ---
if ($opt_n) {
    if ($opt_n !~ /^\//)    # absolute path?
    { $opt_n = $NEWS_ROOT . $opt_n; }
    if ($opt_n !~ /\/$/)    # must end with /
    { $opt_n .= '/'; }
    $NEWS_ROOT = $opt_n;
}

# --- archive directory ---
if ($opt_a) {
    if ($opt_a !~ /^\//)    # absolute path?
    { $opt_a = $NEWS_ROOT . $opt_a; }
    if ($opt_a !~ /\/$/)    # must end with /
    { $opt_a .= '/'; }
    $NEWS_ARCHIVE = $opt_a;
}

# --- redirect stderr ---
if (!$opt_r) {
    open(SAVEERR, ">&STDERR");
    open(STDERR, ">>$NEWS_ERR") || die "Can't redirect stderr";
}

# --- get input file opened ---
if ($infilename = shift(@ARGV)) {
    if ($infilename !~ /^\//)    # absolute filename?
    {
        $infilename = $NEWS_ROOT . $infilename;
    }

} else {
    $infilename = "-";
}
open(INFILE, "<$infilename");

$done = 0;
while (!$done) {
    %sourcefile = ();
    %destfile = ();
    %destname = ();

    # --- loop over each line in infile ---
    # comments start with '#', ignore blank lines, each line is a filename
    while ($srcfile = &timed_getline(INFILE, $timeout)) {
        if ($srcfile =~ /\#/) { $srcfile = $`; }
        if ($srcfile =~ /^\s*/) { $srcfile = $'; }
        if ($srcfile =~ /\s*$/) { $srcfile = $`; }
        if ($srcfile)    # if a filename survived all that...
        {
            if ($srcfile !~ /^\//)    # absolute filename?
            {
                $srcfile = $NEWS_ROOT . $srcfile;
            }
            # $srcfile is now a valid, absolute filename
            # split filename into news directory, newsgroup and article number
            $artnum = -1;
            $remaining = $srcfile;
            if ($remaining =~ /\/(\d*)$/)    # remove / and article number
            { $artnum = $1; $remaining = $`; }
            $regex = &regexp_escape($NEWS_ROOT);
            if ($remaining =~ /^$regex/)     # split off news dir
            { $newsdir = $&; $grpdir = $'; }
            else {
                $newsdir = '';
                $grpdir = $remaining;
            }                                # ... otherwise, grp = dir
            $newsgrp = $grpdir;
            $newsgrp =~ s/\//\./g;           # replace slash (/) with dot (.)
            if ($opt_f) {
                $grpdir = "$newsgrp.gz";
            } else {
                $grpdir .= "/archive.gz";
            }
            $destfile = $NEWS_ARCHIVE . $grpdir;

            # print STDERR "$srcfile --> $newsgrp --> $destfile\n";
            if ($sourcefile{$newsgrp}) { $sourcefile{$newsgrp} .= " "; }
            $sourcefile{$newsgrp} .= $srcfile;
            $destfile{$newsgrp} = $destfile;
            $destname{$newsgrp} = $grpdir;
        }
    }

    # --- is there anything to do at this time? ---
    if (%destfile) {

        # --- open INDEX ---
        if ($opt_i) {
            # make sure directory exists
            if ($opt_i =~ /\/[^\/]*$/) {
                $dirbase = $`;
                system("mkdir -p $dirbase");
            }
            open(INDEX, ">>$opt_i");
        }

        # --- process each article ---
        foreach my $group (keys(%destfile)) {
            # --- make sure parent directories exist ---
            if ($destfile{$group} =~ /\/[^\/]*$/) {
                $dirbase = $`;
                system("mkdir -p $dirbase");
            }

            # --- gzip the concatenated document, appending archive file ---
            open(GZIP, "|gzip -c >> $destfile{$group}")
              || die "Can't open gzip";

            # --- concatenate the articles, keeping header info if needed ---
            @accum_headers = ();
            foreach my $file (split(/\s+/, $sourcefile{$group})) {
                # print STDERR "reading $file...\n";
                $this_doc = '';
                open(DOC, "<$file");
                while ($line = <DOC>) {
                    $this_doc .= $line;
                }
                close(DOC);
                print GZIP $this_doc;
                if ($opt_i) {
                    # --- get header information and store it in index
                    $subject = '';
                    $mesageid = '';
                    $destname = '';
                    if ($this_doc =~ /Subject:\s*(.*)/) { $subject = $1; }
                    if ($subject =~ /^\s*/) { $subject = $'; }
                    if ($subject =~ /\s*$/) { $subject = $`; }
                    if ($this_doc =~ /Message-ID:\s*(.*)/) { $messageid = $1; }
                    if ($messageid =~ /^\s*/) { $messageid = $'; }
                    if ($messageid =~ /\s*$/) { $messageid = $`; }

                    print INDEX "$destname{$group} $messageid $subject\n";
                }
            }

            close(GZIP);
        }

        # --- close index file ---
        if ($opt_i) {
            close(INDEX);
        }
    }

    if (!defined($srcfile))    # file was closed
    {
        $done = 1;
        last;                  # "break"
    }

}

# --- restore stderr ---
if (!$opt_r) {
    close(STDERR);
    open(STDERR, ">>&SAVEERR");
}

# --- close input file ---
close(INFILE);

__END__
# Local Variables:
# mode: perl
# End:

# Copyright 1999 Stephen M. Benoit, Service Providers of America (SPA).
#
# Permission to use, copy, modify, and distribute this software and its
# documentation for any purpose without fee is hereby granted without fee,
# provided that the above copyright notice appear in all copies and that both
# that copyright notice and this permission notice appear in supporting
# documentation, and that the name of SPA not be used in advertising or
# publicity pertaining to distribution of the software without specific,
# written prior permission.  SPA makes no representations about the
# suitability of this software for any purpose.  It is provided "as is"
# without express or implied warranty.
#
# SPA DISCLAIMS ALL WARRANTIES WITH REGARD TO THIS SOFTWARE, INCLUDING ALL
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS.  IN NO EVENT SHALL
# SPA BE LIABLE FOR ANY SPECIAL, INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY
# DAMAGES WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN
# AN ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
