noslenj123 has asked for the wisdom of the Perl Monks concerning the following question:

I have created a windows service using PDK. This service loops over file names and then opens a socket to a server retrieves the files contents via socket communication.

I can't seem to stop my service, it just keeps copying files nonstop. I'm not sure what to place in my code to know when the service wants to stop. I tried placing a "if (!ContinueRun())" trap in the "while" loop that reads the incoming data, but no luck there.

Any ideas?

sub Startup {
    while (ContinueRun($delay)) {

        # BACKUP CTS LOGS : Backup CTS server zipped logs that are not
+ backed up yet
        foreach my $site (@sites) {
            BackupLogFiles($site) if ( BetweenHoursOf($maintenance_sta
+rt,$maintenance_stop) );
        }
    }
}

sub BackupLogFiles {
    my ($site) = @_;

    my @list = &GetZipList( $site );
    foreach my $entry (@list) {
        my ($file,$size) = split(/,/,$entry);
        &RetrieveFile($file,$size,$base_dir,$site) if ( BetweenHoursOf
+($maintenance_start,$maintenance_stop) );
        PerlSvc::Sleep(2);
    }
}

sub RetrieveFile {
    my ($file,$size,$base_dir,$site) = @_;
    my ($IP,$data,$buffer,$bytes_written,$bytes_needed,@ret,$percent,$
+dbh);

    # Get just the file name without the directory
    $file =~ /^.+\/(.+)$/;
    my $output_name = $1;
    $base_dir .= "/$site" . 'Pilot';

    # If we already have this file, skip it
    if (-e "$base_dir/$output_name") { return }

    # Get Ip address for this server
    ->snip<-

    # Connect to server
    my $socket = new IO::Socket::INET(PeerAddr => $IP, PeerPort => CTS
+_PORT, Proto => 'tcp', Timeout => 5);
    if (!$socket) {
        ->snip<-
    }
    $|=1; # Turn off output buffering

    # Create a new SessionSet to manage the socket as non-blocking
    my $set = SessionSet->new;
    if (!$set) {
        ->snip<-
    }

    # Create connection object to work with socket
    my $conn = $set->add($socket);
    if (!$conn) {
        ->snip<-
    }

    # Initiate request to CTS server
    my $request = sprintf('%010u%s',length("GETF1$file"),"GETF1$file")
+;
    my $rc = $conn->write($request);

    my $done;
    if ( ! -e "$base_dir" ) { mkdir "$base_dir" }
    open (OUT,">$base_dir/$output_name");
    binmode(OUT);
    while ( ! $done ) {
        my @ready = $set->wait(5);
        if ( @ready ) {
            if ( my $bytes = $conn->read($data,BUFFERSIZE) ) {
                if ($bytes > 0) {

                    # If we haven't got the byte count of the file bei
+ng
                    # transferred, get it
                    if (!$bytes_needed) {
                        if (length($data) >=10) {
                            $bytes_needed = substr($data,0,10);
                            $data = substr($data,10); # trim off the l
+ength header
                        }
                    }
                    my $wrote = syswrite(OUT,$data);
                    $bytes_written += $wrote;

                    # If we have read what we expected, then we're don
+e
                    if ( $bytes_written == $bytes_needed ) {
                        $conn->close;
                        $done++;
                    }
                }
            } else {
                warn "Server disconnected\n" if $command_line;
                $conn->close;
            }
        } else {
            warn "Server did not respond in 5 seconds\n" if $command_l
+ine;
            $done++;
        }
    }
    close(OUT);
}

[download]

janitored by ybiC: Balanced <readmore> tags around longish codeblock, as per Monastery convention

Replies are listed 'Best First'.
Re: Can't Stop my PerlSvc
by bsdz (Friar) on Sep 18, 2004 at 03:09 UTC
    Separate your program from your service, compile it into a a executable, say backupsvr.exe. Then build a PDK service that creates and kills the process using Win32::Process. Add backupsvr.exe to your included files using PerlSvc.exe e.g. 
    package PerlSvc;

use strict;
use Win32::Process;

our %Config;

sub Startup {
    my $Process;
    my $backupsvr = PerlSvc::extract_bound_file('backupsvr.exe');
    Win32::Process::Create(
        $Process,
        $backupsvr,
        'backupsvr',
        0,
        NORMAL_PRIORITY_CLASS,
        "."
    );
    while (ContinueRun(10)) { }
    $Process->Kill(0);
}

sub Pause { }
sub Continue { }
sub Interactive { }
sub Help { }

sub Install {
    $Config{ServiceName} = 'MyBackupService';
    $Config{DisplayName} = 'My Backup Service';
}

sub Remove {
    $Config{ServiceName} = 'MyBackupService';
}

package main;

1;

    [download]
[reply]
[d/l]
      An excellent idea. I have spent some time trying to get that to work without luck.

      I see my service program start in task manager and then I see my real program start for a couple seconds and then go away. Win32::GetLastError() says "Overlapped I/O operation is in progress."

      I'll continue to troubleshoot. Any idea what that message means?

[reply]
        • What is a CTS server and doesn't it use standard protocols such as HTTP or FTP? If not what is the protocol spec?
        • Do you have a copy of server code? I imagine it's something like: - 
          while (sleep 2) {
  foreach my $site (@sites) {
    BackupLogFiles($site)
     if (BetweenHoursOf($maintenance_start,$maintenance_stop));
  }
}

          [download]
        • Also in your sample code I noticed that you make the test: - 
               if (BetweenHoursOf($maintenance_start,$maintenance_stop));

          [download]
          in BackupLogFiles and your continuous loop, is that neccesary?
[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom