#!/usr/bin/perl -w

######################################################################
###
###   IMPORTANT!
###   Please read the warranty and legal notice
###   at the end of this file!
###
######################################################################


# Probleme:
# - ACHTUNG: Ich habe "rsh" durch "ssh" ersetzt!

# Neue Features zu implementieren:
# - Web::FileCopy: http://www.perl.com/CPAN/authors/id/B/BZ/BZAJAC/
# - rsync statt ftp/copy verwenden!
# - Verzeichnisse OHNE Unterverzeichnisse Syncen!
# - Testmodus: Nur anzeigen, was getan würde, aber nicht kopieren/löschen.
# - eine oder mehrere Quellplatten
# - eine oder mehrere Zielplatten
# - Platten sind entweder Wechselplatten oder fest eingebaut
# - Platte ist gar nicht vorhanden, sondern eine FileInfo-Datei
# - Quelle oder Ziel ist TAR-File
# - Remote-Kopieren per rsh ( -rsh )
# - ssh statt rsh verwenden
# - Files nicht kopieren, sondern nur einen Patch übertragen
# - freien Ziel-Plattenplatz feststellen
# - Alle im Ziel existierenden Files, die neuer in der Quelle sind kopieren,
#   OHNE _alle_ Quell-Files zu kopieren! Es fehlt also z.b. der
#   Schalter: -only_existing_files o.ae.
# - optional mit bzip2 komprimieren


require 5.000;
use lib '/usr/local/bin',"$ENV{HOME}/bin",'/usr/stud/loescher/bin';
use lib 'd:/bin','c:/mydos','c:/bin';
use slutil;
use English;
use Net::FTP;
use Time::ParseDate;
use File::Basename;
use File::Copy;
use Data::Dumper;


######################################################################
### Voreinstellungen
######################################################################

$version = '0.67';
$appname = 'Syncdir';

$debug          = $FALSE;
$compress       = $FALSE;
$delete         = $FALSE;
$ignore_mtime   = $FALSE;
$ignore_links   = $FALSE;
$deref_links    = $FALSE;
$createinfo     = $FALSE;
$force          = $FALSE;
$nossh          = $FALSE;
$infofile       = '';
$mtime_diff     = 0;
$include        = '';
$exclude        = '';
$default_ftp_timeout = 120;
$fehlerexit     = 2;

# Konstanten:
$CHECK                      = $TRUE;
$NO_CHECK                   = $FALSE;
$UNLINK_DEST_BEFORE_COPY    = $TRUE;
$NO_UNLINK_DEST_BEFORE_COPY = $FALSE;
$tempfile = CreateUniqueFile("syncdir",GetTempDir(),".","$ENV{HOME}");
die "Kann Tempfile nicht erstellen!\n" if $tempfile eq '';

######################################################################
### Hauptprogramm
######################################################################

&Hilfe if ($#ARGV<0);

printumlaute Kopf();

while ( $ARGV[0] =~ /^-/ )
{
 OPTION:
  {
    if ($ARGV[0] eq '-compress')
    { $compress = $TRUE;                             shift @ARGV; last OPTION }
    if ($ARGV[0] eq '-delete')
    { $delete = $TRUE;                               shift @ARGV; last OPTION }
    if ($ARGV[0] =~ /^-include=(.+)/)
    { $include = $1;                                 shift @ARGV; last OPTION }
    if ($ARGV[0] =~ /^-exclude=(.+)/)
    { $exclude = $1;                                 shift @ARGV; last OPTION }
    if ($ARGV[0] eq '-ignore-mtime')
    { $ignore_mtime = $TRUE;                         shift @ARGV; last OPTION }
    if ($ARGV[0] eq '-debug')
    { $debug = $TRUE;                                shift @ARGV; last OPTION }
    if ($ARGV[0] eq '-ignore-links')
    { $ignore_links = $TRUE;                         shift @ARGV; last OPTION }
    if ($ARGV[0] eq '-deref-links')
    { $deref_links = $TRUE;                          shift @ARGV; last OPTION }
    if ($ARGV[0] eq '-force')
    { $force = $TRUE;                                shift @ARGV; last OPTION }
    if ($ARGV[0] eq '-no-ssh')
    { $nossh = $TRUE;                                shift @ARGV; last OPTION }
    if ($ARGV[0] =~ /^-ic(.+)/)
    { $createinfo = $TRUE; $infofile = $1;           shift @ARGV; last OPTION }

    # Sonst:
    die "Option $ARGV[0] gibt es nicht!\n";
  }
}

# Umsetzung ":" -> "|"
$include =~ s/:/|/g if $include ne '';
$exclude =~ s/:/|/g if $exclude ne '';

&Hilfe if ($#ARGV < 0);

# Test, ob "gzip" verfügbar
if ($compress)
{
  die "Kann 'gzip' zum Komprimieren nicht finden!\n" unless which('gzip');
}

$source = shift;
$dest   = shift;
# Die Slashes am Ende wegmachen
$source = KillSlashAtEnd($source);
$dest   = KillSlashAtEnd($dest  );
# print "Quelle: '$source'\n";
# print "Ziel:   '$dest'\n";
$dest = $dest . '/.' if ($dest =~ /:$/); # Sonst klappt es bei FTP-Zielen, wie
#                                          z.B. "sl.sl.de:/" nicht!
print "Verwende Temp-File: $tempfile\n";

# Feststellen, ob Quelle oder Ziel per FTP angesprochen werden soll
# Wenn $source etwas der Art "user@rechner:/verz" ist, dann wird $source
# zu "/verz/" und in $src_ftp ist dann das FTP-Objekt. (Offene Session!)
$src_ftp  = $FALSE;
$dest_ftp = $FALSE;
($source,$src_ftp, $src_host ) = TestForFTPAndStartFTP($source);
($dest  ,$dest_ftp,$dest_host) = TestForFTPAndStartFTP($dest  );

die "Quellverzeichnis existiert nicht!\n" if (! $src_ftp && ! -d $source);

$rsh = $FALSE;
$rsh = TestForRshAndPerl($dest,$dest_ftp,$dest_host) if $dest_ftp;
print "Prima! Auf dem Zielrechner ist Perl per rsh erreichbar!\n" if $rsh;

# Wenn Ziel FTP ist, dann...
if ($dest_ftp && ! $rsh)
{
  # ... MTime ignorieren, weil man die nicht ändern kann.
  $ignore_mtime = $TRUE;
  # ... Symlinks dereferenzieren, weil man die im Ziel nicht anlegen kann.
  $deref_links  = $TRUE;
}
$mtime_diff   = 86400 if ($src_ftp || $dest_ftp); # (Ein Tag Toleranz)

# Ziel-Verzeichnis erstellen, wenn es noch nicht existiert
CreateDestDir($dest,$dest_ftp);

# Aus "~/ziel" ein "/home/user/ziel" machen und überprüfen:
$source = ExpandTilde($source, $src_ftp, $CHECK)    if $src_ftp;
$dest   = ExpandTilde($dest,   $dest_ftp,$NO_CHECK) if $dest_ftp;

print "Quelle: $source\n";
print "Ziel:   $dest\n";

unless ($dest_ftp)
{ print "Im Ziel sind noch ",int2dotint(df($dest))," Bytes frei.\n"; }

print "Einlesen der Verzeichnisstrukturen...\n";

# Im Ziel ein File erstellen. Dann kann man erkennen, ob beim Kopieren
# ein Zyklus entstehen würde.
$zyklentestfile = ErstelleZyklenTestFile($dest,$dest_ftp);

# Fileliste erstellen
@src_files  = ();
@dest_files = ();

FindFileWithInfo($source,1,$src_ftp,$include,$exclude,\@src_files);
$total_src_files = $#src_files;
print "Quellfiles:         " . int2dotint($total_src_files) . "\n";

UnlinkZyklenTestFile($zyklentestfile,$dest_ftp);

FindFileWithInfo($dest,  1,$dest_ftp,$include,$exclude,\@dest_files);
$total_dest_files = $#dest_files;
print "Zielfiles:          " . int2dotint($total_dest_files) . "\n";

# Nicht hier!!!
# # Im Ziel ein File erstellen. Dann kann man erkennen, ob beim Kopieren
# # ein Zyklus entstehen würde.
# $zyklentestfile = ErstelleZyklenTestFile($dest,$dest_ftp);

# Test auf doppelte Files derart: "file.txt" und "file.txt.gz"
# und gleich gz-Endungen abschneiden
# .gz wird nur abgeschnitten, wenn auch "Compress" aktiviert ist!
RemoveGZandCheckDupes(\@src_files);
RemoveGZandCheckDupes(\@dest_files);

# Den Pfad-Anfang jeweils abschneiden, sodaß es relative Pfade werden.
# Aus '/tmp/quelle/sub/uboot.mod' wird '/sub/uboot.mod'
CutFromName(length($source), \@src_files );
CutFromName(length($dest),   \@dest_files);

# Test auf Zyklen beim Kopieren
Zyklentest($zyklentestfile,\@src_files);
# UnlinkZyklenTestFile($zyklentestfile,$dest_ftp);


# Test fuer Data:Dumper()
#
# WriteFileInfo('info.txt',\@src_files);
# @src_files=();
# ReadFileInfo('info.txt',\@src_files);
# PrintFileInfo(\@src_files);
# exit;


# Alle alten Files feststellen, die nur am Ziel existieren
%mark = ();
foreach $zeile (@src_files)
{
  $mark{$zeile->{NAME}}++;
}
@old = ();
foreach $zeile (@dest_files)
{
  push @old,$zeile if !$mark{$zeile->{NAME}};
}

print "ALTE FILES:\n" if $debug;
PrintFileInfo(\@old) if $debug;


# Alle Files feststellen, die am Ziel noch nicht existieren
%mark = ();
foreach $zeile (@dest_files)
{
  $mark{$zeile->{NAME}} = $zeile;
}
@new  = ();
@both = ();
foreach $zeile (@src_files)
{
  if (!$mark{$zeile->{NAME}})
  { push @new, $zeile } # Diese existieren nur in der Quelle
  else
  {
    # Diese sind am Ziel und an der Quelle
    # Die Files brauchen wir uns nur merken, wenn sie unterschiedlich sind
    if (!$ignore_mtime) # Mtime berücksichtigen
    {
      unless (defined $zeile->{TYP})
      { warn "Undefinierter Typ für File '$zeile->{NAME}'!\n" }
      # Wenn es ein Link ist und Links angelegt werden sollen
      if ($zeile->{TYP} eq 'L' && ! $deref_links)
      {
	# Datum und Größe ist bei Links uninteressant.
	# Der Link im Ziel zeigt auf etwas anderes als der Link in der Quelle
	# -> update
	if ( ($zeile->{LINKTO} ne $mark{$zeile->{NAME}}->{LINKTO}) )
	{ push @both,$zeile; }
      }
      else
      {
	$differenz = abs($zeile->{MTIME} - $mark{$zeile->{NAME}}->{MTIME});
	$differenz = 0 if $differenz <= $mtime_diff;
	if (
	    ( $differenz != 0 ) ||
	    # Größe nur vergleichen, wenn nicht komprimiert wird!
	    ($zeile->{SIZE}  != $mark{$zeile->{NAME}}->{SIZE}) && !$compress
	   )
	{ push @both,$zeile; }
      }
    }
    else # Mtime ignorieren
    {
      if ( $zeile->{SIZE} != $mark{$zeile->{NAME}}->{SIZE})
      { push @both,$zeile; }
    }
  }
}

print "NEUE FILES:\n" if $debug;
PrintFileInfo(\@new) if $debug;
print "BEIDE FILES:\n" if $debug;
PrintFileInfo(\@both) if $debug;


# Speicher freigeben
undef %mark;
undef @src_files;
undef @dest_files;


# Trennung in Files und Verzeichnisse
@old_files = ();
@old_dirs  = ();
foreach $zeile (@old)
{
  # Files und Links
  if ($zeile->{TYP} eq "F" || $zeile->{TYP} eq "L")
  {
    push @old_files,$zeile;
    next;
  }
  # Verzeichnisse
  if ($zeile->{TYP} eq "D")
  {
    push @old_dirs,$zeile; # unless $zeile->{NAME} eq "";
    next;
  }
  warn "Hoppla: '$dest$zeile->{NAME}' ist kein File und kein Verzeichnis!?\n";
}
undef @old;


@new_files = ();
@new_dirs  = ();
foreach $zeile (@new)
{
  # Files und Links
  if ($zeile->{TYP} eq "F" || $zeile->{TYP} eq "L")
  {
    push @new_files,$zeile;
    next;
  }
  if ($zeile->{TYP} eq "D")
  {
    push @new_dirs,$zeile;# unless $zeile->{NAME} eq "";
    next;
  }
  warn"Hoppla: '$source$zeile->{NAME}' ist kein File und kein Verzeichnis!?\n";
}
undef @new;


@both_files = ();
foreach $zeile (@both)
{
  # Files und Links
  if ($zeile->{TYP} eq "F" || $zeile->{TYP} eq "L")
  {
    push @both_files,$zeile;
    next;
  }
  next if $zeile->{TYP} eq "D"; # Verzeichnisse ändern sich idR nicht. :)
  warn"Hoppla: '$source$zeile->{NAME}' ist kein File und kein Verzeichnis!?\n";
}
undef @both;


print "----------\n" if $debug;
print "NEUE FILES:\n" if $debug;
PrintFileInfo(\@new_files) if $debug;
print "NEUE DIRS:\n" if $debug;
PrintFileInfo(\@new_dirs) if $debug;
print "ALTE FILES:\n" if $debug;
PrintFileInfo(\@old_files) if $debug;
print "ALTE DIRS:\n" if $debug;
PrintFileInfo(\@old_dirs) if $debug;
print "BEIDE FILES:\n" if $debug;
PrintFileInfo(\@both_files) if $debug;

$count_both = @both_files;
$count_old  = @old_files;
$count_new  = @new_files;
printumlaute "Files für Update:   $count_both\n";
printumlaute "Zu löschende Files: $count_old\n";
print        "Neue Files:         $count_new\n";

# Wenn es mehr als 5 Prozent der Gesamtfiles im Ziel gelöscht würden, dann
# nachfragen
if ($delete && ($count_old > $total_dest_files*5/100) )
{
  printumlaute "\nEs sollen im Ziel mehr als 5 Prozent der Files gelöscht ".
  "werden!\n";
  if (! $force)
  {
    printumlaute "Sind Sie sicher, daß die Verzeichnisse stimmen? ";
    $input = readkey;
    print "\n";
    exit unless $input =~ /^[jJyY]$/;
  }
}


# Löschen
if ($delete)
{
  # Files löschen
  if (@old_files)
  {
    printumlaute "Lösche alte Files...\n";
    MyUnlink($dest,\@old_files,$dest_ftp);
  }

  # Verzeichnisse löschen...
  if (@old_dirs)
  {
    printumlaute "Lösche alte Verzeichnisse...\n";
    MyRmdir($dest,\@old_dirs,$dest_ftp);
  }
}


# Files auf Veränderungen testen
printumlaute "\nÜberprüfe Files auf Veränderungen... ";
if (@both_files)
{
  print "\n";
  foreach $zeile (@both_files)
  {
    MyCopy($zeile, $src_ftp, $dest_ftp, $UNLINK_DEST_BEFORE_COPY);
  }
}
else
{
  print "Keine.\n";
}


# Neue Verzeichnisse erstellen
if (@new_dirs)
{
  print "Erstelle neue Verzeichnisse...\n";
  foreach $zeile (sort DirSort @new_dirs)
  {
    $dname = $dest.$zeile->{NAME};
    print "$dname\n";

    # Direkter Zugriff
    if (!$dest_ftp)
    {
      (undef,undef,$mode,undef,$uid,$gid,undef,undef,$atime,$mtime)
      = stat($source.$zeile->{NAME});
      BetterMkdir($dname,$mode,$uid,$gid,$atime,$mtime);
    }

    # FTP-Zugriff
    else
    {
      FTPBetterMkdir($dname,$dest_ftp);
    }
  }
}


# Neue Files kopieren
if (@new_files)
{
  print "Kopiere neue Files...\n";
  foreach $zeile (@new_files)
  {
    MyCopy($zeile, $src_ftp, $dest_ftp, $NO_UNLINK_DEST_BEFORE_COPY);
  }
}


print "Fertig!\n";


######################################################################
### Unterprogramme
######################################################################


###
### FileInfo-Struktur ist wie folgt definiert:
###
# Liste von Hashes mit dem Aufbau:
# (x1, x2, x3, ...), wobei xi Hashes der Art sind:
# $x->{MEDIUM} # Medien-Nummer
# $x->{NAME}   # Filename (kompletter Pfad)
# $x->{SIZE}   # Filegröße
# $x->{MTIME}  # Modification-Time
# $x->{TYP}    # File-Typ: "D": Verzeichnis, "F": File, "L": Link, "?": sonst
# $x->{MODE}   # File-Mode, also Permissions (dezimal)
# $x->{UID}    # Numerische User-ID
# $x->{GID}    # Numerische Group-ID
# $x->{GZ}     # TRUE, wenn File eine .gz-Endung hatte, sonst FALSE
# $x->{LINKTO} # Wenn TYP=L, dann steht hier das Link-Ziel
#             Anwendung: Wenn $quelle->{TYP}='L' dann
#             symlink("$quelldir/$quelle->{LINKTO}", "$zieldir/$quelle->{NAME}"
# Wenn also z.B. @xxx die Liste ist, dann kann man auf den Namen des 11.ten
# Files so darauf zureifen: $xxx[10]->{NAME}


sub PrintFileInfo
{
  # Parameter: Referenz auf FileInfo-Struktur
  #
  my $liste = shift;
  foreach $file (@$liste)
  {
    print "$file->{MEDIUM} $file->{TYP} $file->{MTIME} $file->{SIZE} $file->{MODE} $file->{NAME}\n";
  }
}

sub WriteFileInfo
{
  # Schreibt die FileInfo-Struktur in eine Datei in dieser Reihenfolge:
  # TYP, MTIME, SIZE, MODE, UID, GID, NAME, LINKTO, GZ
  # Parameter: (Filename, FileInfo-Struktur)
  my ($infofile, $liste) = @_;
  my $fh = FileHandle->new();
  open($fh, ">$infofile") || die "Kann '$file' nicht schreiben!\n";
  $Data::Dumper::Terse = 1;
  $Data::Dumper::Indent = 0;
  print $fh &Dumper($liste);
  close $fh;
}


sub ReadFileInfo
{
  # Liest die FileInfo-Struktur aus einer Datei.
  # Parameter: (Filename, FileInfo-Struktur)
  my ($infofile, $liste) = @_;
  my $ref;
  my $daten;
  {
    local $/ = undef;
    my $fh = FileHandle->new();
    open($fh, "<$infofile") || die "Kann '$file' nicht lesen!\n";
    #  undef $/;
    $daten = <$fh>;
    close $fh;
    #  $/ =  "\n";
  }
  eval("\$ref = $daten");
  push @$liste, @$ref;
}


sub FindFileWithInfo
{
  # Parameter: (Verzeichnis, Medium, FTP, Include, Exclude, Referenz_auf_Liste)
  #  - Verzeichnis: Start-Verzeichnis für den Find, z.B. "/usr/local/"
  #  - Medium: Nummer der Disk
  #  - FTP: Wenn TRUE, dann besteht nur eine FTP-Verbindung zu dem Verzeichnis
  #         (Die Verbindung muß bereits aufgebaut sein!)
  #         Wenn FALSE, dann ist direkter Zugriff auf das Filesystem möglich.
  #  - Include: Auswahl-Muster
  #  - Exclude: Ausschluß-Muster
  #  - Liste: Eine Referenz auf eine (leere) Liste für Rückgabe
  #
  # Rückgabe: Übergebene Listenreferenz wird mit FileInfo-Struktur gefüllt
  #
  my ($dir,$medium,$ftp,$include,$exclude,$list) = @_;
  my $fileinfo;
  my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks);

  # Bei direktem Zugriff
  if (!$ftp)
  {
    my @files = myfind($dir);
    while ($file = shift @files)
    {
      # Include-Pattern anwenden
      next if ( ($include ne '') && ! ($file =~ /$include/o) );
      # Exclude-Pattern anwenden
      next if ( ($exclude ne '') &&   ($file =~ /$exclude/o) );
      $fileinfo = {};
      # Man bedenke: -f ist auch bei Links TRUE!
      if    (-l $file) { $fileinfo->{TYP} = 'L' } # Link
      elsif (-f _    ) { $fileinfo->{TYP} = 'F' } # File
      elsif (-d _    ) { $fileinfo->{TYP} = 'D' } # Directory
      else             { $fileinfo->{TYP} = '?' } # Sonstwas
      # Symlinks ggf. gleich überspringen
      next if ($ignore_links && $fileinfo->{TYP} eq 'L');
      ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
       $atime,$mtime,$ctime,$blksize,$blocks)
      = lstat(_);
      if ( $deref_links && ($fileinfo->{TYP} eq 'L') )
      {	
	# Wenn $deref_links, dann die SIZE und MODE vom eigentlichen File
	# nehmen
	(undef,undef,$mode,undef,undef,undef,undef,$size,undef,$mtime)
	= stat($file);
	if (-d _)
	{
	  # Dereferenzieren von Links auf Verzeichnisse funktioniert nicht.
	  # Es wird der Link dann fälschlicherweise wie ein File behandelt.
	  # Abhilfe: Wenn ein Verzeichnis deref. werden soll, dann einen
	  # extra Find() darauf loslassen.
	  print "Link auf ein Verzeichnis: '$file'!\n";
	  # Wir tun so, als wäre es ein Verzeichnis:
	  $fileinfo->{TYP} = 'D';
	  # alt: my @LinkDerefFiles = myfind($file);
	  my @LinkDerefFiles = myfind($file.$slash);
	  push @files, @LinkDerefFiles[1..$#LinkDerefFiles];
	}
      }
      # Wenn es ein Link ist, dann auslesen
      if ($fileinfo->{TYP} eq "L")
      {
	$fileinfo->{LINKTO} = readlink($file);
      }
      $fileinfo->{MEDIUM} = $medium;
      $fileinfo->{NAME}   = $file;
      $fileinfo->{SIZE}   = $size;
      $fileinfo->{MTIME}  = $mtime;
      $fileinfo->{MODE}   = $mode;
      $fileinfo->{UID}    = $uid;
      $fileinfo->{GID}    = $gid;
      push @$list, $fileinfo;
    }
  }

  # Bei FTP-Zugriff
  else
  {
    my $zeile;
    my @files = ();
    my @dirs  = ();
    my ($ok,$typ,$mode,$owner,$group,$size,$date,$file,$linkto);

    # Hauptverzeichnis auch in die Liste aufnehmen
    $fileinfo = {};
    $fileinfo->{MEDIUM} = $medium;
    $fileinfo->{NAME}   = $dir;
    $fileinfo->{SIZE}   = 0;
    $fileinfo->{MTIME}  = 0;
    $fileinfo->{TYP}    = 'D';
    $fileinfo->{MODE}   = 0;
    $fileinfo->{UID}    = -1;
    $fileinfo->{GID}    = -1;
    push @$list, $fileinfo;

    # Initialisierung: Liste der Unterverzeichnisse enthält Anfangsverzeichnis
    $dirs[0] = $dir;

    while ($subdir = shift @dirs)
    {
      print "\n##### DIR: '$subdir'\n" if $debug;
      foreach $zeile ($ftp->dir($subdir))
      {
	print $zeile . "\n" if $debug;
	($ok,$typ,$mode,$owner,$group,$size,$date,$file,$linkto)
	= SplitFTPLine($zeile);
	next unless $ok;
	# Symlinks ggf. gleich überspringen
	next if ($ignore_links && $typ eq 'L');
	$file = $subdir . ($subdir =~ /$slashsuch$/ ? '' : $slash) . $file;
	# Include-Pattern anwenden
	next if ( ($include ne '') && ! ($file =~ /$include/o) );
	# Exclude-Pattern anwenden
	next if ( ($exclude ne '') &&   ($file =~ /$exclude/o) );
	$fileinfo = {};
	if ($typ eq 'D') # Verzeichnis
	{
	  print "DIR:  $file\n" if $debug;
	  if (! ($file =~ /$slashsuch\.{1,2}$/) ) # Nicht in '..' absteigen!
	  {
	    print "(in dieses Verzeichnis muß man noch rein...)\n" if $debug;
	    # In diese Unterverzeichnisse müssen wir noch rein!
	    push @dirs,$file;
	  }
	  # Alle "."- und ".."-Verzeichnisse nicht in die Liste aufnehmen:
	  next if $file =~ /$slashsuch\.{1,2}$/;
	}
	if ($typ eq 'L') # Link
	{
	  print "LINK:  '$file' -> '$linkto'\n" if $debug;
	  if ($deref_links)
	  {
	    if ( FTPIsDir($subdir.$slash.$linkto,$ftp) )
	    {
	      # Dereferenzieren von Links auf Verzeichnisse funktioniert nicht.
	      # Es wird der Link dann fälschlicherweise wie ein File behandelt.
	      # Abhilfe: Wenn ein Verzeichnis deref. werden soll, dann einen
	      # extra Find() darauf loslassen.
	      print "Link auf ein Verzeichnis: '$file'!\n" if $debug;
	      # Wir tun so, als wäre es ein Verzeichnis:
	      $typ = 'D';
	      push @dirs,$file.$slash;
	    }
	    else
	    {
	      # Wenn $deref_links, dann die SIZE und dem MODE vom eigentlichen
	      # File nehmen
	      # Nicht bei Verzeichnis-Links!
	      ($mode,undef,undef,$size) = FTPLinkStat($file,$ftp);
	    }
	  }
	  else
	  {
	    $fileinfo->{LINKTO} = $linkto;
	  }
	}
	$fileinfo->{MEDIUM} = $medium;
	$fileinfo->{NAME}   = $file;
	$fileinfo->{SIZE}   = $size;
	$fileinfo->{MTIME}  = $date;
	$fileinfo->{TYP}    = $typ;
	$fileinfo->{MODE}   = $mode;
	$fileinfo->{UID}    = $owner;
	$fileinfo->{GID}    = $group;
	push @$list, $fileinfo;
      }
    }
  }
}


sub FTPLinkStat
{
  # Führt einen stat() auf einen Link per FTP durch.
  # Nicht auf Verzeichnisse anwenden!
  # Parameter: (File, FTP)
  # File ist dabei ein Link: "xyz -> abc"
  # Return: ($mode,$uid,$gid,$size,$mtime)
  my ($typ,$mode,$uid,$gid,$size,$mtime,$linkto);
  my $count = 0;
  my ($file,$ftp) = @_;

  nochmal_LinkStat:
  my $zeile = ($ftp->dir($file))[0];
  print "FTPLinkStat(): ", $zeile . "\n";# if $debug;
  (undef,undef,$mode,$uid,$gid,$size,$mtime,$file,$linkto)
  = SplitFTPLine($zeile);
  $file =~ s/(.*)$slashsuch[^$slashsuch]+$/$1/;
  $ftp->cwd($file);
  $zeile = ($ftp->dir($linkto))[0];
  print "               ", $zeile . "\n";# if $debug;
  (undef,$typ,$mode,$uid,$gid,$size,$mtime,$file) = SplitFTPLine($zeile);

  # Wenn das wieder ein Link ist, dann wieder dereferenzieren
  $count++;
  die "Zyklischer Link '$file'!\n" if $count > 100;
  goto nochmal_LinkStat if $typ eq 'L';

  return ($mode,$uid,$gid,$size,$mtime);
}


sub FTPIsDir
{
  # Stellt fest, ob der übergebene Name ein Verzeichnis oder File ist.
  # Wenn Verzeichnis, dann TRUE
  # Parameter: (Verzeichnis, FTP)
  my ($verz,$ftp) = @_;
  return $ftp->cwd($verz) ? $TRUE : $FALSE;
}


sub ErstelleZyklenTestFile
{
  # Erstellt ein File um später damit Zyklen erkennen zu können.
  # Parameter: (Verzeichnis, FTP)
  # Return:    Name des Files
  my ($verz,$ftp) = @_;
  my $neu;
  if (!$ftp)
  {
    $neu = CreateUniqueFile('zyk'.CreateRandomName(),$verz);
#    die "Kann Zyklentestfile nicht erstellen!\n" if $neu eq '';
    if ($neu eq '')
    {
      warn "Kann Zyklentestfile nicht erstellen!\n";
      exit $fehlerexit;
    }
  }
  else
  {
    $neu = $ftp->put_unique($tempfile,$verz.$slash."zyklentest.tmp");
    if (!defined $neu) # put_unique hat nicht funktioniert.
    {
      $neu = $ftp->put($tempfile,$verz.$slash."zyklentest.tmp");
    }
  }
  warn "Fehler: Zyklen-Testfile ist nicht definiert!\n" unless defined $neu;
  return (defined $neu ? $neu : '');
}


sub CreateRandomName
{
  # Liefert einen zufälligen Filenamen, z.B.: 988209631294012
  #
  srand;
  my $name = rand().rand();
  $name =~ s/\.//g;
  return $name;
}


sub UnlinkZyklenTestFile
{
  # Löscht das Zyklen-Testfile
  # Parameter: (File, FTP)
  my ($file,$ftp) = @_;
  return unless defined $file;
  if (!$ftp)
  { unlink $file }
  else
  {
    $ftp->delete($file);
  }
}


sub Zyklentest
{
  # Parameter: Zyklenfile, Quellfileliste
  my ($file,$liste) = @_;
  return if $file eq '';

  $file =~ s/.*$slashsuch([^$slashsuch]+)$/$1/; # Nur den Filenamen
  foreach $zeile (@$liste)
  {
    if ($zeile->{NAME} =~ /$slashsuch$file$/o)
    {
      die "Zyklisches Kopieren! (Testfile ist: '$file')\n";
    }
  }
}


sub SplitFTPLine
{
  # Parameter: Zeile der Art:
  # -r-xr-xr-x   1 owner    group         43472 Apr 18  1995 scopy.exe
  # oder
  # dr--r--r--   1 owner    group             0 May 27 13:37 subdir
  # oder
  # lrwxr-xr-x   1 owner    group             4 Feb  8  1996 news -> News
  #
  # Return: ($ok,$isDir,$rechte,$owner,$group,$size,$date,$file)
  # $ok ist $TRUE, wenn die anderen Werte gültig sind, d.h. die Zeile richtig
  # erkannt wurde, sonst $FALSE
  #
  my $input = shift;
  my ($ok,$typ,$rechte,$owner,$group,$size,$date,$file,$linkto);
  my $filename;

  ($rechte,$owner,$group,$size,$date,$file) =
  (
   $input =~ /
   ^
   ([-dlrwxstST]{10})\s+ # Rechte
   \d+\s+
   (.+?)\s+           # Owner
   (.+?)\s+           # Group
   (\d+)\s+           # Größe
   ([A-Z][a-z]{2}\s+\d{1,2}\s+\d{1,2}:*\d\d)\s+ # Datum
   (.*)$              # Filename
   /x
  );

  $ok = defined $file;
  unless ($ok)
  {
    unless ($input =~ /^total/)
    { print "Kann Zeile nicht zerlegen:\n   $input\n" }
    return $FALSE;
  }

  if    ($rechte =~ /^-/) { $typ = 'F' }
  elsif ($rechte =~ /^d/) { $typ = 'D' }
  elsif ($rechte =~ /^l/) { $typ = 'L' }
  else                    { $typ = '?' }

  if ($typ eq 'L') # Link
  {
    # Der Filename sieht so aus: 'file -> linkfile'
    ($filename,$linkto) = split(/ -> /,$file);
    if ( $file ne join(' -> ',($filename,$linkto)) )
    { print "Fehler beim Link-Aufteilen: '$file'\n" }
    $file = $filename;
  }

  print "PARSE: ". join("#",($typ,$rechte,$owner,$group,$size,$date,$file,
			     (defined $linkto ? $linkto : '')))."\n" if $debug;

#alt:  $date = parsedate($date); # In Zahl umwandeln
  # PREFER_PAST heißt: when year or day of week is ambiguous, assume past
  # Weil sonst ein "Dec 13 14:11" im Januar als Zukunft herauskommt!
  $date = parsedate($date,PREFER_PAST => $TRUE); # In Zahl umwandeln

  # UID/GID evtl. umwandeln
  unless ( $owner =~ /^\d+$/ )
  {
    (undef,undef,$owner,$group) = getpwnam($owner);
    ($owner,$group) = (-1,-1) unless defined $owner;
  }
  print "UID: $owner, GID: $group\n" if $debug;

  return ($ok,$typ,AsciiPerm2Int($rechte),$owner,$group,$size,$date,$file,
	  $linkto);
}


sub AsciiPerm2Int
{
  # Parameter: File-Permissions in der Form: "-rwxr-xr-x"
  # Return:    File-Permissions als Dezimal-Zahl
  #            (Kann direkt in chmod() verwendet werden)
  #
  my $input = shift;

  # Ersten Buchstabe [dl-] für {Dir,Link,File} ignorieren
  $input = substr($input,1);

  # In (User,Group,World) unterteilen
  $input =~ /(...)(...)(...)/;
  warn "Falsche Parameter an AsciiPerm2Int() gegeben!\n" unless defined $3;
  my @ugw = ($1,$2,$3);
  my $tripel;
  my $result = 0;
  my $stelligkeit = 100;
  my ($r,$w,$x);
  for $tripel (@ugw)
  {
    # rwx entspricht den Wertigkeiten: 4,2,1
    $tripel =~ /(.)(.)(.)/;
    ($r,$w,$x) = ($1,$2,$3);
    # r
    warn "Kann $input nicht parsen!\n" unless $r =~ /[r-]/;
    $result += 4*$stelligkeit if $r eq 'r';
    # w
    warn "Kann $input nicht parsen!\n" unless $w =~ /[w-]/;
    $result += 2*$stelligkeit if $w eq 'w';
    # x
    warn "Kann $input nicht parsen!\n" unless $x =~ /[xstST-]/;
    $result += 1*$stelligkeit if $x =~ /[xst]/;
    # Parsen der s-, t-, S-, und T-Bits
    if ($x =~ /[stST]/)
    {
      $result += 1*1000 if $stelligkeit == 1;
      $result += 2*1000 if $stelligkeit == 10;
      $result += 4*1000 if $stelligkeit == 100;
    }
    $stelligkeit /= 10;
  }
  return oct($result);
}


sub TestForRshAndPerl
{
  # Liefert einen FileHandle mit offener Verbindung zu einem Remote-Perl,
  # wenn auf dem Zielrechner Perl per rsh-Kommando erreichbar ist.
  # Sonst: $FALSE
  # Parameter: Verzeichnis, ftp-Object, Rechnername
  #

  if ($nossh)
  {
    return $FALSE;
  }

  my ($dir,$ftp,$host) = @_;
  $host =~ s/:$//;
  my $fh  = FileHandle->new();
  open($fh, ">$tempfile") || die "Kann '$tempfile' nicht schreiben!\n";
  my $teststring = "Syncdir $$ " . localtime();
  print $fh "print \"$teststring\"";
  close $fh;
  my $name = $ftp->put_unique($tempfile,"$dir/syncdir.rsh");
  return $FALSE unless defined $name;
  my $result = `ssh $host perl $name`;
  $ftp->delete($name);
  if ( defined($result) && ($result eq $teststring) )
  {
    $fh = FileHandle->new();
    open($fh, "| ssh $host perl -") || die "Problem mit ssh!\n";
    return $fh;
  }
  else { return $FALSE }
}


sub TestForFTPAndStartFTP
{
  # Parameter: String der Form "user@host:/verz" oder nur "/verz"
  # Wenn String in ftp-Format ist, dann wird eine FTP-Session geöffnet
  #
  my $input = shift;
  my $orig  = $input;

  # Splitten in User@Host und Verzeichnis
  $input =~ s/(.*?)@(.*)/$2/;
  my $user = defined $1 ? $1 : "";
  $input =~ s/(.*?):(.*)/$2/;
  my $host = defined $1 ? $1 : "";
  my $verz = $input;
  # Wenn der Hostname nur einen Buchstaben lang ist, dann ist es kein Host,
  # sondern ein Laufwerksbuchstabe, wie DOSish Systeme haben.
  $host = '' if length($host)==1;
  print "Parse: User: '$user', Host: '$host', Verzeichnis: '$verz'\n"if $debug;

  # Wenn kein Host, dann auch kein FTP
  return (DerefLink($orig),$FALSE,'') if $host eq '';

  my $timeout = $ENV{SYNCDIR_FTP_TIMEOUT} || $default_ftp_timeout;
#  my $ftp = Net::FTP->new($host, Timeout => $timeout, Debug => 0);
  my $ftp = Net::FTP->new($host, Timeout => $timeout, Passive => 1);
  unless ($ftp)
  {
    printumlaute "Keine FTP-Verbindung möglich!\n";
    exit $fehlerexit;
  }

  # Wenn kein Loginname angegeben ist, dann verwende .netrc
  if ($user eq '')
  {
    print "Verwende .netrc ...\n";
    $ftp->login() || die "FTP-Zugriff verweigert!\n";
  }
  # Sonst Login mit Passwort
  else
  {
#    if ( ($osname ne 'aix') && ($osname ne 'linux') )
#    {
#      printumlaute
#"ACHTUNG: Die Paßwort-Routine ist für '$osname' noch ungetestet!
#Das zeichenweise unsichtbare Eingeben funktioniert evtl. noch nicht richtig!
#Bitte melden Sie mir dies, da Terminals systemabhängig sind.
#Bei Anonymous-Login wird das Paßwort zur Kontrolle ausgegeben.\n";
#    }
#    printumlaute "Paßwort für $host: ";
#    my $password = ReadWithoutEcho();
#    printumlaute "Paßwort für $host: ";
#    my $password = ReadWithoutEcho();
    my $password = ReadWithoutEcho("Paßwort für $host: ",'STDIN');
    print "\n";
    print "Anonymous-Paßwort ist: '$password'\n" if $user eq "anonymous";
    $ftp->login($user,$password) || die "FTP-Zugriff verweigert!\n";
    $password = "";
  }

  $ftp->binary;

  return ($verz,$ftp,$host.":");
}


sub DerefLink
{
  # Es wird ein Link dereferenziert und das Ergebnis zurückgegeben
  # Bsp.: /m/ (In Wahrheit ein Link auf /mnt/mo und das wiederum ein Link
  # Link auf /mnt/meinMO), dann wird /mnt/meinMO zurückgegeben.
  #
  my $input = shift;
  return $input unless -l $input;
  while (-l $input)
  {
    $input = readlink($input);
    die "Link auf '$input' zeigt ins Leere!\n" unless -e $input;
  }
  return $input;
}


sub ExpandTilde
{
  # Tilde in FTP-Verzeichnisnamen expandieren.
  # Parameter: (Verzeichnis, FTP-Objekt, Check)
  # Wen Check TRUE, dann wird Existenz des Verz. getestet, sonst nicht.
  # Return: echter Verzeichnisname

  my ($verz,$ftp,$check) = @_;
  my $home;
  print "Verzeichnisname: '$verz'\n" if $debug;
  return $verz unless $verz =~ /^~/;
  $ftp->cwd('~');
  $home = $ftp->pwd();
  # 257 "/" is current directory.
  # Windows liefert sowas: '257 "/temp" is current directory on "d:".'
  # Und die FTP-Lib liefert dann : '/temp" is current directory on "d:'
  $home = $1 if $home =~ /(.+)\".*\"/;
  $verz =~ s/^~/$home/;
  print "Echter Remote-Verzeichnisname: '$verz'\n" if $debug;
  if ($check)
  {
    $ftp->cwd($verz);
    $real = $ftp->pwd();
    die "Verzeichnis '$verz' existiert nicht!\n" if $verz ne $real;
  }
  return $verz;
}


# sub ReadWithoutEcho
# {
#   my $key;
#   my $input = "";
#   system("stty -echo");
#   chomp($input = <STDIN>);
#   system("stty echo");
#   return $input;
# }


sub DirSort
{
  # Sortiert nach Filenamen 
  # (um Verzeichnisse in richtiger Reihenfolgen anlegen zu können.)
  $a->{NAME} cmp $b->{NAME};
}


sub CreateDestDir
{
  # Parameter: (Verzeichnis, FTP)
  # Es wird das "Verzeichnis" angelegt. Wenn FTP ein FTP-Objekt ist, dann
  # per ftp, sonst direkt.
  #
  my ($verz,$ftp) = @_;
  if ($ftp)
  {
    FTPBetterMkdir($verz,$ftp) || die "Kann '$verz' nicht erstellen!\n";
  }
  else
  {
    -e $verz || BetterMkdir($verz) || die "Kann '$verz' nicht erstellen!\n";
  }
}


sub FTPBetterMkdir
{
  # Parameter: (Verz,FTP)
  # Verz: das anzulegende Verzeichnis, z.B. "/temp/test/neu/subdir/"
  # FTP:  Net::FTP-Objekt mit offener Session
  #
  # Es werden nicht vorhandene Verzeichnisse per FTP angelegt.
  # Bsp.: Es existiert bereits: /tmp/test
  # FTPBetterMkdir("/tmp/test/neu/subdir/ganzunten")
  # legt den ganzen Pfad an. (Das kann mkdir() nicht!)
  #
  # Return: $TRUE bei Erfolg, sonst $FALSE
  #
  my ($input,$ftp) = @_;

  my $leading = "";
  if (substr($input,0,1) eq $slash)
  {
    $leading = $slash;
    $input   = substr($input,1);
  }
  # Unter DOS gibt es sowohl "/" (intern) als auch "\".
  my @verz = split(/[\\\/]/, $input);
  my $dir  = $leading;
  my $i;
  my $error = 0;
  for ($i=0; $i<=$#verz; $i++)
  {
    $dir = $dir . $verz[$i];
    if (! $ftp->cwd($dir) ) # Test, ob es das Verzeichnis gibt
    {
      $ftp->mkdir($dir) || $error++;
    }
    $dir .= $slash;
  }
  return ($error > 0 ? $FALSE : $TRUE);
}


sub MyUnlink
{
  # Parameter: (Rootdir, Referenz auf Info-Liste von Files, FTP)
  # Es werden alle Files gelöscht (per FTP, wenn definiert)
  #
  my($root,$list,$ftp) = @_;
  my $zeile;
  foreach $zeile (@$list)
  {
    $dname = $root.$zeile->{NAME};
    print "$dname\n";

    # Direkter Zugriff
    if (!$ftp)
    {
      $dname .= '.gz' if ($compress && $zeile->{GZ});
      unlink($dname) || printumlaute "Fehler beim Löschen von '$dname'!\n";
    }

    # FTP-Zugriff
    else
    {
      $ftp->delete($dname)||printumlaute "Fehler beim Löschen von '$dname'!\n";
    }
  }
}

sub MyRmdir
{
  # Parameter: (Rootdir, Referenz auf Info-Liste von Dirs, FTP)
  # Es werden alle Verzeichnisse gelöscht (per FTP, wenn definiert)
  #
  my($root,$list,$ftp) = @_;
  my $zeile;
  foreach $zeile (@$list)
  {
    $dname = $root.$zeile->{NAME};
    print "$dname\n";

    # Direkter Zugriff
    if (!$ftp)
    {
      rmdir($dname)||printumlaute "Kann Verzeichnis '$dname' nicht löschen!\n";
    }

    # FTP-Zugriff
    else
    {
      $ftp->rmdir($dname) ||
      printumlaute "Kann Verzeichnis '$dname' nicht löschen!\n";
    }
  }
}


sub MyCopy
{
  # Parameter: (Info über Quellfile, QuellFTP, ZielFTP, Unlinken vor Kopieren)
  # Es wird Quellfile nach Zielfile kopiert
  # Wenn Quelle oder Ziel per FTP erreichbar ist, dann per FTP, sonst direkt.
  # Der letzte Parameter bestimmt, ob das Zielfile vorher gelöscht werden
  # soll, oder überschrieben werden soll.
  # (Konstanten: $UNLINK_DEST_BEFORE_COPY oder $NO_UNLINK_DEST_BEFORE_COPY)
  #
  my ($info, $src_ftp, $dest_ftp, $unlink) = @_;
  my $sname = $source.$info->{NAME};
  $sname .= ".gz" if ($compress && $info->{GZ});
  my $dname = $dest  .$info->{NAME};
  print "$src_host$sname -> $dest_host$dname\n";

  ####################################
  # Keine FTP-Verbindung zu Quelle und Ziel, also direkter Zugriff
  ####################################
  if (!$src_ftp && !$dest_ftp)
  {
    if ($unlink)
    {
      if ($compress)
      {
	# gz- oder nicht-gz- Files löschen, wenn sie existieren
	unlink($dname.'.gz') if -e $dname.'.gz';
	unlink($dname      ) if -e $dname      ;
      }
      else
      {
	unlink($dname) if $unlink;
      }
    }

    unless ( CopyFilesDirectAccess($info, $sname, $dname) )
    {
      # Test, ob vielleicht das File während syncdir läuft gelöscht wurde
      if  (! -e $sname) 
      {
	# (-l $$ !-e) sind Links, die ins Leere zeigen
	if (-l $sname)
	{ print "Link '$sname' zeigt auf nicht vorhandenes File!\n" }
	else
	{ printumlaute "File '$sname' wurde während Syncdir läuft gelöscht!\n"}
      }
      else
      {
	# File existiert, ist aber nicht lesbar
	if (! -r $sname)
	{ print "File '$sname' ist nicht lesbar!\n"; }
	else
	{
	  print "Fehler beim Kopieren!\n";
	  exit $fehlerexit;
	}
      }
    }

    if ( $compress && ($info->{TYP} ne 'L') ) { system('gzip -q '.$dname) }
  }


  ####################################
  # FTP-Verbindung zu Quelle und Ziel
  ####################################
  elsif ( $src_ftp && $dest_ftp)
  {
    $dest_ftp->delete($dname) if $unlink;
    # Wenn es kein Link ist oder Links dereferenziert werden sollen
    if ( ($info->{TYP} ne 'L') || $deref_links )
    {
      $src_ftp->get($sname,$tempfile) 
      || die "Fehler beim Empfangen von '$sname'\n";
      $dest_ftp->put($tempfile,$dname)
      || die "Fehler beim Senden nach '$dname'\n";
      if ($rsh)
      {
	print $rsh "utime $info->{MTIME}, $info->{MTIME}, '$dname';";
	print $rsh "chmod $info->{MODE}, '$dname';\n";
	if ($compress) { print $rsh "system('gzip -q $dname');\n" }
      }
    }
    else # Ein Link
    {
      if ($rsh)
      {
	print $rsh "symlink('$info->{LINKTO}','$dname');\n";
	# Auf Links kein utime oder chmod machen! (Ändert sonst Original!)
      }
    }
  }


  ####################################
  # FTP-Verbindung nur zu Quelle
  ####################################
  elsif ($src_ftp)
  {
    unlink($dname) if $unlink;
    # Wenn es kein Link ist oder Links dereferenziert werden sollen
    if ( ($info->{TYP} ne 'L') || $deref_links )
    {
      $src_ftp->get($sname,$dname)
      || die "Fehler beim Empfangen von '$sname'\n";
      utime $info->{MTIME}, $info->{MTIME}, $dname;
      chmod $info->{MODE}, $dname;
    }
    else # Ein Link
    {
      symlink($info->{LINKTO},$dname);
      # Auf Links kein utime oder chmod machen! (Ändert sonst Original!)
    }
    if ( $compress && ($info->{TYP} ne 'L') ) { system('gzip -q '.$dname) }
  }


  ####################################
  # FTP-Verbindung nur zu Ziel
  ####################################
  elsif ($dest_ftp)
  {
    $dest_ftp->delete($dname) if $unlink;
    # Wenn es kein Link ist oder Links dereferenziert werden sollen
    if ( ($info->{TYP} ne 'L') || $deref_links )
    {
      $dest_ftp->put($sname,$dname)
      || die "Fehler beim Senden nach '$dname'\n";
      if ($rsh)
      {
	print $rsh "utime $info->{MTIME}, $info->{MTIME}, '$dname';";
	print $rsh "chmod $info->{MODE}, '$dname';\n";
	if ($compress) { print $rsh "system('gzip -q $dname');\n" }
      }
    }
    else # Ein Link
    {
      if ($rsh)
      {
	print $rsh "symlink('$info->{LINKTO}','$dname');\n";
	# Auf Links kein utime oder chmod machen! (Ändert sonst Original!)
      }
    }
  }
}


sub CopyFilesDirectAccess
{
  # Parameter: (Info über Quellfile, Quellname, Zielname)
  # Es wird Quellfile nach Zielfile kopiert.
  # (Diese Funktion ist identisch mit slutil::FileCopyPreserveAll() mit
  # dem Unterschied, daß diese Funktion keine stat()s mehr macht.
  # Return: Bei Erfolg TRUE, sonst FALSE
  #
  my ($info, $quelle, $ziel) = @_;
  my $errorcode = 0;

  # Testen, ob die Quelle und Ziel gleichen Typ haben
  if (-d $ziel)
  {
    printumlaute "Am Ziel existiert bereits ein Verzeichnis mit demselben ",
    "Namen!\n","Es wird aus Sicherheitsgründen nicht gelöscht.\n";
    return $FALSE;
  }

  return $FALSE unless -e $quelle;

  # Unter DOS kann File::Copy() keine Verzeichnisse anlegen!
  if ($osname eq "dos")
  {
    my $dirname = $ziel;
    $dirname    =  dirname($dirname);
    BetterMkdir($dirname) unless -d $dirname;
  }

  # Wenn die Quelle ein Link ist
  if ( ($info->{TYP} eq 'L') && ! $deref_links )
  {
    $errorcode = symlink($info->{LINKTO},$ziel);
  }

  # Quelle ist ein normales File
  else
  {
    $errorcode = copy($quelle, $ziel)
  }

  chown $info->{UID}, $info->{GID}, $ziel if ($osname ne "dos");
  # Auf Links KEIN utime und chmod, weil sich sonst das Original ändert!
  if ( ($info->{TYP} ne 'L') || $deref_links )
  {
    utime $info->{MTIME}, $info->{MTIME}, $ziel;
    chmod $info->{MODE}, $ziel;
  }

  return $errorcode;
}


sub CutFromName
{
  # Parameter: (Anzahl, Referenz auf FileInfo-Struktur)
  # Return:    geänderte FileInfo-Struktur
  # Es werden "Anzahl" Zeichen vom Anfang des NAME-Felds abgeschnitten
  #
  my $len =   shift;
  my $liste = shift;
  foreach $file (@$liste)
  {
    $file->{NAME} = substr($file->{NAME},$len);
  }
}


sub RemoveGZandCheckDupes
{
  # Parameter: Referenz auf FileInfo-Struktur
  # Return:    geänderte FileInfo-Struktur
  #
  my $liste = shift;
  my $name;
  my %mark = ();

  foreach $file (@$liste)
  {
    # GZ-Endung abschneiden
    if ($compress) 
    {
      # Merken, ob es komprimiert war oder nicht:
      $file->{GZ} = ( $file->{NAME} =~ s/\.gz$//) ? $TRUE : $FALSE;
    }

    # Nach doppelten Suchen
    $name = $file->{NAME};
    if (defined $mark{$name})
    {
      print "ACHTUNG: DIESER FALL SOLLTE NICHT EINTRETEN!\n" unless $compress;
      print "Warnung: Zum File '$name' existiert auch ein '$name.gz'!\n";
      print "         Es wird nur '$name' aktualisiert.\n";
    }
    $mark{$name}++;
  }
}


END
{
  # Ende-Funktion wird auf jeden Fall aufgerufen
  unlink $tempfile if -e $tempfile;
  UnlinkZyklenTestFile($zyklentestfile,$dest_ftp);
  # Verbindungen schließen.
  $src_ftp->quit()   if $src_ftp;
  $dest_ftp->quit()  if $dest_ftp;
}


sub Kopf
{
  my $head = "$appname $version   -   von Stephan Löscher";
  return "\n$head\n" . '~' x length($head) . "\n";
}


sub Hilfe
{
  printumlautepaged
  Kopf().
"Syntax: syncdir [optionen] QUELLE ZIEL

SyncDir vergleicht das Quell-Verzeichnis mit dem Ziel-Verzeichnis und
kopiert dann alle Files von QUELLE nach ZIEL, die am ZIEL noch nicht
existieren oder die in QUELLE neuer sind als in ZIEL.

Optionen:
-compress       : Komprimiert Files am Ziel
-delete         : Löscht Files, die nur am Ziel existieren
-include=PAT1:PAT2:... : Include-Pattern (Perl-RE) zum Auswählen von Files.
                         Default: '.*' (alles).   Bsp.: -include=\\.c:\\.h:\\.tgz
-exclude=PAT1:PAT2:... : Exclude-Pattern (Perl-RE) zum Ausschließen von Files.
                         Default: '' (nichts).    Bsp.: -exclude=temp.\\d+:\\.bak
-ignore-mtime   : Es werden Files nicht durch den Zeitstempel verglichen,
                  sondern nur durch ihre Größe.
-debug          : Gibt reichlich interne Informationen aus
-force          : Schaltet sicherheitsrelevante Rückfragen aus (VORSICHT!)
-no-ssh         : versucht nicht per SSH zu verbinden

Schalter für Symbolische Links:
-ignore-links   : Ignoriert symbolische Links
-defref-links   : Dereferenziert symbolische Links (Es wird das File angelegt
                  und nicht der Link.)

Wenn QUELLE oder ZIEL so aufgebaut ist:
rechner:verzeichnis
user\@rechner:verzeichnis
dann wird eine FTP-Verbindung aufgebaut. (~/.netrc wird verwendet)
Wenn man einen FTP-Proxy bzw. Firewall verwenden will/muß, dann muß
im Environment FTP_FIREWALL=rechnername definiert sein.
Wenn man den Passive-FTP-Modus verwenden muß, weil der Server dumm ist
oder ein Firewall so konfiguriert ist, dann muß im Environment
FTP_PASSIVE=true definiert werden.
Den Default-FTP-Timeout von ",$default_ftp_timeout,
" Sekunden kann man mit SYNCDIR_FTP_TIMEOUT=wert
im Environment beliebig einstellen.

Die optionale ~/.netrc hat folgenden Aufbau:
machine ZIELRECHNERNAME login ZIELLOGIN password ZIELKENNWORT

Einschränkungen bei FTP-Sync wegen FTP-Protokoll:
- Wenn Zielfiles per FTP erstellt werden und auf dem Zielrechner kein Perl per
  rsh ereichbar ist, dann stimmt die MTime nicht
  mit der des Quellfiles überein. Umgekehrt jedoch schon:
  syncdir host:/quelle/ /ziel/ ist also zu bevorzugen.
  Wenn das ZIEL per FTP angesprochen wird und kein Perl per rsh erreichbar ist,
  dann ist deshalb automatisch die Option '-ignore-mtime' aktiv.
  Sonst werden Zeitunterschiede bis zu einem Tag toleriert, da die
  'Meßgenauigkeit' über FTP im schlechtesten Fall nicht besser ist.
- Der Besitzer und Gruppe ändert sich auf den Empfänger, wenn der Remote-
  Besitzer lokal nicht bekannt ist.
- Per FTP kann kein symbolischer Link angelegt werden, außer auf der
  Zielmaschine ist Perl per rsh verfügbar. Ansonsten werden symbolische Links
  dereferenziert (Schalter: -deref-links)

Bekannte Probleme:
- Unter DOS werden keine leeren Verzeichnisse kopiert
  (Wegen xdir bzw. fehlendem readdir())

---------------------------------------------------------------
AB HIER ERST TEILWEISE IMPLEMENTIERT: (Alpha oder Beta-Status!)
---------------------------------------------------------------

-mediumX : mehrere Medien (X=q für Quelle oder X=z für Ziel)
-infoXFILE : InfoFile FILE für Quelle oder Ziel (X=q oder X=z)
          X=c : Erzeuge InfoFile
       syncdir -icFILE DIR
          (Erstellt das InfoFile FILE für das Vereichnis DIR.)
       syncdir -iqFILE ZIEL
          (In ZIEL werden alles File gelöscht, die nicht in FILE stehen.)
       syncdir -izFILE QUELLE TEMPZIEL
          (Es werden alle in FILE (also eigentlich ZIEL) geänderten Files
           nach TEMPZIEL kopiert. Das Verzeichnis TEMPZIEL kann man dann 
           zu dem System, auf dem ZIEL existiert mitnehmen.)

Return-Wert:
 0 : Nichts kopiert
 1 : Files kopiert
 2 : Abbruch wegen Fehler (bereits implementiert)

";
exit;

}


######################################################################
#
# Warranty and legal notice
# ~~~~~~~~~~~~~~~~~~~~~~~~~
#
# Copyright (c) 1997 by Stephan Löscher  -  all rights reserved
# My Address: Stephan Löscher, Dr.Troll-str. 3, 82194 Gröbenzell, Germany
# Email: loescher@gmx.de
# WWW: http://www.loescher-online.de/
#
# This program is freeware.
# It is NOT Public-Domain-Software!
# The author (Stephan Löscher) does NOT give up his copyright, but he 
# reserves his copyright. Usage and copying is free of charge for private
# use, but NOT for commercial use!
# 
# You may and should copy this program free of charge, use it,
# give it to your friends, upload it to a BBS or something similar, under
# the following conditions:
# * Don't charge any money for it. If you upload it to a BBS, make sure that
#    it can be downloaded free (without paying for downloading it, except
#    for usage fees that have to be paid anyway). Small copying fees (up to
#    5 DM or 3 $US) may be charged.
#  * Only distribute the whole original package, with all the files included.
#  * This program may not be part of any commercial product or service without
#    the written permission by the author.
#  * If you want to include this program on a CD-ROM and/or book, please send
#    me a free copy of the CD/book (this is not a must, but I would appreciate
#    it very much).
# 
# Distribution of the program is explicitly desired, provided that the above
# conditions are accepted.
# 
# YOU ARE USING THIS PROGRAM AT YOUR OWN RISK! THE AUTHOR (STEPHAN LÖSCHER)
# IS NOT LIABLE FOR ANY DAMAGE OR DATA-LOSS CAUSED BY THE USE OF THIS PROGRAM
# OR BY THE INABILITY TO USE THIS PROGRAM. IF YOU ARE NOT SURE ABOUT THIS, OR
# IF YOU DON'T ACCEPT THIS, THEN DO NOT USE THIS PROGRAM!
# BECAUSE OF THE VARIOUS HARDWARE AND SOFTWARE ENVIRONMENTS INTO WHICH THIS
# PROGRAM MAY BE PUT, NO WARRANTY OF FITNESS FOR A PARTICULAR PURPOSE IS
# OFFERED.
# GOOD DATA PROCESSING PROCEDURE DICTATES THAT ANY PROGRAM BE THOROUGHLY
# TESTED WITH NON-CRITICAL DATA BEFORE RELYING ON IT.
# 
# No part of the documentation may be reproduced, transmitted, transcribed,
# stored in any retrieval system, or translated into any other language in
# whole or in part, in any form or by any means, whether it be electronic,
# mechanical, magnetic, optical, manual or otherwise, without prior written
# consent of the author, Stephan Löscher.
# 
# You may not make any changes or modifications to this software or this
# manual. You may not decompile, disassemble, or otherwise reverse-engineer
# the software in any way.
# If you got the source, then you are permitted to modify it if you
# contact me and tell me your enhancements.
# You also may include the source as a whole or parts of it into other
# programs, as long as you don't make profit directly out of selling
# the result. If you re-use code of this program then do not remove my name!
# If you include this source-code in your projects, mark it clearly as such
# "... derived from code XXX by Stephan Löscher".
# But don't distribute modified code!
# 
# If you believe your copy of this software has been tampered or altered in
# anyway, shape or form, please contact me immediately! Do not hesitate a
# moment to inform me. Remember, this software should be available to all, in
# the original form, so please do not accept modified or damaged versions of
# my software.
# 
# The author reserves his right for taking legal steps if the copyright or the
# license agreement is violated.
# 
# All product names mentioned in this software are trademarks or registered
# trademarks of their respective owners.
# 
# If you have any questions, ideas, suggestions for improvements or if you find
# bugs (I don't hope so.) then feel free to contact me. (Email is appreciated.)
# 
# I'm not a native english speaker. If you are one and discover some strange
# sounding parts in this documentation or in the program, please, feel free
# to point it out to me and give me suggestions for alteration!
# 
# If the program works for you, and you want to honour my efforts, you are
# invited to donate as much as you want... :)
#
# In any case, if you don't like the restrictions in this license, contact
# me, and we can work something out.
#
######################################################################