#!/bin/sh
# -*- perl -*-
# This code allows us to start perl from our path or an environment variable
# rather than hardcoding a path into the #! line.  It works from sh or csh.
(exit $?0) && eval 'exec ${QPERLQ-perl} -x $0 ${1+"$@"}'
if (! $?QPERLQ) setenv QPERLQ perl
exec $QPERLQ -x $0 $argv:q

#!/usr/local/bin/perl -w
#
# $Id: qsfiles_from_samba,v 1.8 1998/05/09 22:21:59 ejb Exp $
# $Source: /home/ejb/source/qsync/util/RCS/qsfiles_from_samba,v $
# $Author: ejb $
#

require 5.002;
use strict;

use Time::Local;

my $whoami = ($0 =~ m,([^/\\]*)$,) ? $1 : $0;
#my $dirname = ($0 =~ m,(.*)[/\\][^/\\]+$,) ? $1 : ".";

my $slow = "";
{
    my @t = @ARGV;
    @ARGV = ();
    while (@t)
    {
	my $arg = shift(@t);
	if ($arg eq "-S")
	{
	    $slow = "-Z";
	}
	else
	{
	    push(@ARGV, $arg);
	}	    
    }
}

if ((@ARGV < 2) || (@ARGV > 5))
{
    &usage();
}

my $host = $ARGV[0];
my $share = $ARGV[1];
my $user = $ARGV[2] || "";
my $pass = $ARGV[3] || "-N";
my $dir = $ARGV[4] || "";
$user = "" if $user eq "-";
$pass = "-N" if $pass eq "-";

my @last_fields = ();
my $first_db = 1;

my %database = ();
my $cur_dir = undef;

my %monthnums = ();
{
    my $i = 1;
    for (qw(jan feb mar apr may jun jul aug sep oct nov dec))
    {
	$monthnums{$_} = $i;
	$i++;
    }
}

my $attrib_readonly = 1;
my $attrib_hidden = 2;
my $attrib_system = 4;
my $attrib_directory = 16;
my $attrib_archive = 32;
my $attrib_normal = 128;
my $attrib_temporary = 256;
my $attrib_compressed = 2048;

my $st_top = 1;
my $st_in_dir = 2;
my $st_done_dir = 3;
my $state = $st_top;

my $top = $dir;
$top =~ s,[/\\]$,,;
$top =~ s,/,\\,g;
$top =~ s/^([^\\])/\\$1/;
$top = "\\" if $top eq "";
my $rtop = $top;
&regexp_quote(\$rtop);

my $user_args = ($user eq "" ? "" : "-U $user");
my $cmd =
    "smbclient \\\\$host\\$share $pass $user_args $slow -D $top -c recurse;ls";
&regexp_quote(\$cmd);
open(SMBLS, "$cmd|") or die "$whoami: can't run smbclient: $!\n";

&set_directory($top);

while (<SMBLS>)
{
    chop;

    # State checking is ordered so that it is possible for the same line
    # to be evaluated in multiple states.

    if ($state == $st_top)
    {
	if (m/^  /)
	{
	    $state = $st_in_dir;
	}
    }

    if ($state == $st_in_dir)
    {
	if (! m/^  /)
	{
	    $state = $st_done_dir;
	}
	else
	{
	    &parse_entry($_);
	}
    }

    if ($state == $st_done_dir)
    {
	if (m/^\\/)
	{
	    &set_directory($_);
	    $state = $st_in_dir;
	}
    }
}
	 
&gen_database();

sub parse_entry
{
    die "$whoami: current directory not set\n" unless defined $cur_dir;

    my $entry = shift;
    return unless $entry =~ m/^  /;
    my @fields = ($entry =~ m/^  (.*?)\s+([RHSDANTC]*)\s+(\d+)\s+\w{3} (\w{3}) +(\d+) +(\d+):(\d+):(\d+) +(\d+)$/);
    if (scalar(@fields) != 9)
    {
	warn "$whoami: unrecognizable entry $entry\n";
	return;
    }
    my ($name, $attribs, $size, $mon, $day, $hour, $min, $sec, $year) =
	@fields;

    $mon =~ tr/A-Z/a-z/;
    $mon = $monthnums{$mon};

    if ($year < 1970)
    {
	($sec, $min, $hour, $day, $mon, $year) = (0, 0, 0, 1, 1, 1970);
    }
    my $timestamp = timelocal($sec, $min, $hour, $day, $mon - 1, $year - 1900);
    my $mode = 0;

    $mode |= $attrib_readonly if $attribs =~ m/R/;
    $mode |= $attrib_hidden if $attribs =~ m/H/;
    $mode |= $attrib_system if $attribs =~ m/S/;
    $mode |= $attrib_directory if $attribs =~ m/D/;
    $mode |= $attrib_archive if $attribs =~ m/A/;
    $mode |= $attrib_normal if $attribs =~ m/N/;
    $mode |= $attrib_temporary if $attribs =~ m/T/;
    $mode |= $attrib_compressed if $attribs =~ m/C/;

    my $isdir = ($attribs =~ m/D/);

    push(@{$database{$cur_dir}}, [$name, $size, $mode, $timestamp, $isdir]);
}

sub set_directory
{
    $cur_dir = shift;
    $cur_dir =~ s/\\$// unless $cur_dir eq "\\";
    $database{$cur_dir} = [];
}

sub gen_database
{
    my $dir = $_[0] || $top;
    $dir =~ s/^\\\\/\\/;
    if (! exists($database{$dir}))
    {
	warn "$whoami: INTERNAL ERROR: " .
	    "unable to find information for -$dir-\n";
	return;
    }
    my @entries = @{$database{$dir}};
    my ($my_timestamp, $my_size, $my_mode) = (0, 0, $attrib_directory);
    my $num_entries = 0;
    for (@entries)
    {
	my ($name, $size, $mode, $timestamp, $isdir) = @$_;
	if ($name eq ".")
	{
	    $my_timestamp = $timestamp;
	    $my_size = $size;
	    $my_mode = $mode;
	}
	elsif ($name eq "..")
	{
	    # skip
	}
	else
	{
	    $num_entries++;
	    if ($isdir)
	    {
		&gen_database("$dir\\$name");
	    }
	    else
	    {
		&output_entry("$dir\\$name", $timestamp, $size, $mode, "");
	    }
	}
    }
    &output_entry("$dir", $my_timestamp, $my_size, $my_mode, $num_entries);
}

sub output_entry
{
    my ($name, $timestamp, $size, $mode, $extra) = @_;
    $name =~ s,^$rtop,\./,;
    $name =~ s,\\,/,g;
    $name =~ s,^\.//,\./,;
    
    if ($first_db)
    {
	$first_db = 0;
	open(DB, ">&STDOUT") || die "$whoami: open database failed: $!\n";
	print DB "SYNC_TOOLS_DB_VERSION 3\n";
    }

    # The easiest way to create a version 3 database entry is to create
    # a version 2 entry and convert it.

    $_ = join("\001",
	      ($name, $timestamp, $size, sprintf("0x%x", $mode),
	       "0", "0", "1", $extra, "\n"));
    $_ = join("\001", "", sprintf("%d", length($_) - 1), $_);
    m/^(.)/;
    my $delim = $1;
    my @fields = split($delim, $_);
    my @tmpfields = @fields;
    my $name_samelen = 0;
    if (@last_fields)
    {
	# filename is 2
	my $len = &matchlen($fields[2], $last_fields[2]);
	if ($len > 2)
	{
	    substr($fields[2], 0, $len) = "";
	    $name_samelen = $len;
	}
	my $i;
	for ($i = 5; $i <= 8; $i++)
	{
	    # mode, uid, gid, links
	    if ($fields[$i] eq $last_fields[$i])
	    {
		$fields[$i] = "";
	    }
	}
    }
    shift(@fields);
    shift(@fields);
    my $fields = join($delim, @fields);
    my $len = length($fields) - 1;
    $len .= "/$name_samelen" if ($name_samelen);
    print DB "$delim$len$delim$fields";
    @last_fields = @tmpfields;
}

sub matchlen
{
    my ($s1, $s2) = @_;
    my $len = 0;
    while (length($s1) && length($s2))
    {
	$s1 =~ s/^(.)//;
	my $c1 = $1;
	$s2 =~ s/^(.)//;
	my $c2 = $1;
	if ($c1 eq $c2)
	{
	    $len++;
	}
	else
	{
	    last;
	}
    }
    $len;
}

sub regexp_quote
{
    my $strp = shift;

    $$strp =~ s/[^\w\s]/\\$&/g;
}

sub usage
{
    die "Usage: $whoami [-S] host share [user [pass [dir]]]\n";
}