Service permission?

Service is running as a member of Domain Admins, this is definitely a perl service issue.

I have tried a cut down version of the script on my workstation, an if(open) still succeeds even when the directories are renamed.

This all works fine as a script, however when compiled as a service, it fails to detect failures

So, in the simple example that you showed, the service runs the "#something GOOD" block, and then you find out that nothing was appended to the file -- is that it?

Why not include a check for file size before and after you have opened the file, appended data, and closed it? e.g.:

my $refsize = (-s $filename);
my $appendstr = "12345678\015\012";

if ( open( FH, ">>$filename" )) {
    print FH $appendstr;
    close FH;
    if (-s $filename != $refsize + length( $appendstr ) {
        warn "open succeeded on $filename, but write failed";
        # something bad
    } else {
        # something good
    }
} else {
    # a different something bad
}
[download]

Granted, having the script behave differently in different contexts is a bad deal, but being at a loss about how to fix that, I would keep looking for another way of performing the intended server test that just gets around the problem.

(I assume the test must also include reading the file back at some point, to determine the last time stamp written to the file. Why not include that as a condition for entering the "something GOOD" block?)

I have tried to script around the problem using the stat command to check modified times, this seems to work OK but my main issue at the moment is one of the script hanging.

I'm assuming (!) that this is because it's opening file handles to things that aren't actually there, hence this is my area of attack. Here's a full copy of the code..

# Main loop:
# 

package PerlSvc;


# these variables cannot be 'my'
$Name = 'Filepoll';
$DisplayName = 'File Poll Service';


sub Startup {

    # Read in inifile values
    ::GetConfig();

    # Get list of servers for this DSM
    @allservers = ::GetServerList();

    # remove excluded servers
    for $item (@::ExcludeList){
        chomp $item;
        $seen{$item} = 1;
    }
    for $server (@allservers){
        if (!$seen{$server}){
            push (@servers, $server);
        }
    }

    $total = scalar(@servers);
    $serverstring = join (",",@servers);
    ::Log("FilePoll service started checking $total servers: $serverst
+ring ignoring: $::Exclude");


    # Set all stored status's to a 1 (O.K)
    %status = %pingstatus = ();
    for $server (@servers) {
        chomp $server;
        $status{$server} = 1;
        $pingstatus{$server} = 1;
    }

    my $ticker=0;
    my $now;
    
    ($::Delay lt 0) and ($::Delay = 120);

    while(ContinueRun()) {
        $now = time ();
        if ($now > $ticker) {
            $ticker=$now + $::Delay;

            # Find todays and yesterdays date, for file management

            $today = ::Datestr(time);
            $tooold = time - (24*60*60);
            $thisminute = time - 60;
            $yesterday = ::Datestr($tooold);
            ($todaysdate, undef) = split (" ",$today);
            ($yesterdaysdate, undef) = split (" ",$yesterday);

            # Main loop
            for $servername (@servers){
                last if (!(ContinueRun()));
                chomp $servername;
                $oldfile[0] = "\\\\$servername\\$::PollDir\\$yesterday
+sdate.filepoll";
                $currentfile = "\\\\$servername\\$::PollDir\\$todaysda
+te.filepoll";

                if (::PingCheck($servername) == -1){
                    if ($pingstatus{$servername} eq 0){ 
                        ::Error ("$servername - FilePoll: Failed to wr
+ite to file system on $servername, server not responding to a ping");
                        next;
                    }
                    $pingstatus{$servername} = 0;
                    next;
                }
                else {
                    $pingstatus{$servername} = 1;
                }

                # If a file exists from yesterday, delete it AND all *
+.filepoll files created more than 24 hours ago
                if (-e $oldfile[0]){
                    unlink @oldfile;
                    # Check for any other filepoll files
                    @allfilepolls = <//$servername/$::PollDir/*.filepo
+ll>;
                    @delete = ();
                    for (@allfilepolls){
                        $mtime = (stat("$_"))[10];
                        if ($mtime < $tooold){
                            push @delete, "$_";
                        }
                    }
                    unlink @delete if (@delete);
                }

                # Write to todays file
                
                if (open (FILEPOLL,">>$currentfile")){
                    print FILEPOLL "$today\n";
                    close (FILEPOLL);
                }

                # Check file modification time
                
                $changetime = (stat("$currentfile"))[9];
                if ($changetime < $thisminute){
                    # File hasn't been updated in the last minute
                    $status{$servername} = 0;
                }
                else {
                    $status{$servername} = 1;
                }

                if ($status{$servername} eq 0){ 
                    ::Error ("$servername - FilePoll: Failed to write 
+to file system ($currentfile) on $servername, please check");
                }

            }

        }

        open (LOG,">$::logfile");
        print LOG "Poller Status\n";
        for (keys %status){
            print LOG "$_\t$status{$_}\n";
        }
        print LOG "\nPing Status\n";
        for (keys %status){
            print LOG "$_\t$pingstatus{$_}\n";
        }
        close (LOG);

        sleep (4);
    }
}





sub Install {
    # add your additional install messages or functions here
}

sub Remove {
    # add your additional remove messages or functions here
}

sub Help {
    # add your additional help messages or functions here
}


##############################################################
package main;
##############################################################

# any additional support code can go here

# module references
use Config::Inifiles;
use Win32::TieRegistry ( Delimiter=>"/", ArrayValues=>1 );
use Win32::EventLog;
use Win32::ODBC; 


# Constant definitions

$ImagePath = $Registry->{"LMachine/SYSTEM/CurrentControlSet/Services/$
+PerlSvc::Name//ImagePath"};
$INIFILE = $logfile = $ImagePath->[0];
$INIFILE =~ s/[^\\:]+$/filepoll.ini/;
$logfile =~ s/[^\\:]+$/filepoll.log/;

sub GetConfig () {

    my $cfg = Config::IniFiles->new (-file => "$INIFILE",-default=>"De
+fault");
    if (defined ($cfg)) {
        # load configuration variables.

        $Delay=$cfg->val("Common","PollFileDelay");
        $PollDir = $cfg->val("Common","PollDir");
        $ServerClasses = $cfg->val("Common","ServerClasses");
        $Exclude = $cfg->val("Common","Exclude");

        @ExcludeList = split(/^/,$Exclude);
    }
    else {
        ::Log ("Failed to open $INIFILE."); 
    }
    return;
}


sub Datestr(){
# Generate a date string
    my $time = $_[0];
    my ($sec,$min,$hour,$mday,$mon,$year,undef,undef,undef) = localtim
+e($time);
    $year += 1900;
    $mon += 1;
    $datestr = sprintf ("%2d%s%02d%s%04d%s%2d%s%02d%s%02d",$mday,"-",$
+mon,"-",$year," ",$hour,":",$min,":",$sec);
    return ($datestr);
}

sub PingCheck () {
    my $ipaddress = $_[0];
    my $results = `ping $ipaddress -n 1`;
    return (-1) if ($? != 0);
    return (-1) if ($results =~ /Request timed out/);
    return (-1) if ($results =~ /Destination host unreachable/);
    return (0);
}

sub Error {
    my $message = $_[0];
    `cawto LLH0001ELS $message`;
}

sub Log {
    my $message = $_[0];
    my $EventLog;
    my %event=(
        'EventID',100,
        'EventType',EVENTLOG_INFORMATION_TYPE,
        'Category',NULL,
        'Strings',$message,
    );
    $EventLog = new Win32::EventLog( 'FilePoller' ) || die $!;
    $EventLog->Report(\%event) || die $!;
}

sub GetServerList {
    my @array = ();
    my @results = `wvgethosts -o hosts -c $ServerClasses`;
    
    for (@results){
        push (@array, $1) if (/\s+(\w\w\w\d\d\d\d\w\w\w)\s+\//);
    }
    
    @array = sort {$a cmp $b} @array;
    return (@array);
}
[download]