do_fhem/fhem/core/FHEM/WinService.pm

################################################################
#
#  Copyright notice
#
#  (c) 2013 Thomas Eckardt (Thomas.Eckardt@thockar.com)
#
#  This script is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#
#  The GNU General Public License can be found at
#  http://www.gnu.org/copyleft/gpl.html.
#  A copy is found in the textfile GPL.txt and important notices to the license
#  from the author is found in LICENSE.txt distributed with these scripts.
#
#  This script is distributed in the hope that it will be useful,
#  but WITHOUT ANY WARRANTY; without even the implied warranty of
#  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#  GNU General Public License for more details.
#
#  This copyright notice MUST APPEAR in all copies of the script!
#
################################################################

# $Id: WinService.pm 5819 2014-05-11 14:17:21Z rudolfkoenig $

package FHEM::WinService;

use strict;

sub __installService($$$);
sub __initService($$);
sub new($$$);

use vars qw($VERSION);

$VERSION = $1 if('$Id: WinService.pm 5819 2014-05-11 14:17:21Z rudolfkoenig $' =~ /,v ([\d.]+) /);


###################################################
# Windows Service Handler
#
# install/remove or possibly start fhem as a Windows Service

sub
new ($$$) {
    my ($class, $argv) = @_;

    my $fhem = $0;
    $fhem =~ s/\\/\//go;
    my $fhembase = $fhem;
    $fhembase =~ s/\/?[^\/]+$//o;
    if (! $fhembase && eval('use Cwd();1;')) {
        $fhembase = Cwd::cwd();
        $fhembase =~ s/\\/\//go;
    }
    my $larg = $argv->[@$argv-1];

    if ($larg eq '-i') {
        if (! $fhembase) {
            print "error: unable to detect fhem folder - cancel\n";
            exit 0;
        }
        $fhem = $fhembase.'/'.$fhem if $fhem !~ /\//o;
        my $cfg = $argv->[0];
        $cfg =~ s/\\/\//go;
        $cfg = $fhembase.'/'.$cfg if $cfg !~ /\//o;
        print "try to install fhem windows service as: $^X $fhem $cfg\n";
        __installService('-i' , $fhem, $cfg);
        exit 0;
    } elsif ($larg eq '-u') {
        print "try to remove fhem windows service\n";
        __installService('-u',undef,undef);
        exit 0;
    } else {
        $class = ref $class || $class;
        bless my $self = {}, $class;
        $self->{ServiceLog} = [];
        @{$self->{ServiceLog}} = __initService($self, $argv->[0]);
        return $self;
    }
}
###################################################


###################################################
# from here are internal subs only !
###################################################


###################################################
# install or remove fhem as a Windows Service
#

sub
__installService($$$)
{
 eval(<<'EOT') or print "error: $@\n)";
    use Win32::Daemon;
    my $p;
    my $p2;

    if(lc $_[0] eq '-u') {
        system('cmd.exe /C net stop fhem');
        sleep(1);
        Win32::Daemon::DeleteService('','fhem') ||
          print "Failed to remove fhem service: " .
          Win32::FormatMessage( Win32::Daemon::GetLastError() ) . "\n" & return;
        print "Successfully removed service fhem\n";
    } elsif( lc $_[0] eq '-i') {
        unless($p=$_[1]) {
            $p=$0;
            $p=~s/\w+\.pl/fhem.pl/o;
        }
        if($p2=$_[2]) {
            $p2=~s/[\\\/]$//o;
        } else {
            $p2=$p; $p2=~s/\.pl/.cfg/io;
        }
        my %Hash = (
            name    =>  'fhem',
            display =>  'fhem server',
            path    =>  "\"$^X\"",
            user    =>  '',
            pwd     =>  '',
            parameters => "\"$p\" \"$p2\"",
          );
        if( Win32::Daemon::CreateService( \%Hash ) ) {
            print "fhem service successfully added.\n";
        } else {
            print "Failed to add fhem service: " .
                  Win32::FormatMessage( Win32::Daemon::GetLastError() ) . "\n";
            print "Note: if you're getting an error: Service is marked for ".
                  "deletion, then close the service control manager window".
                  " and try again.\n";
        }
    }
    1;
EOT
}


###################################################
# check if called from SCM and start the service if so
#

sub
__initService ($$) {
    my ($self, $arg) = @_;
    my @ServiceLog;

    # check how we are called from the OS - Console or SCM
    
    # Win32 Daemon and Console module installed ?
    if( eval("use Win32::Daemon; use Win32::Console; 1;") ) {
      eval(<<'EOT');
        my $cmdlin = Win32::Console::_GetConsoleTitle () ? 1 : 0;

        eval{&main::doGlobalDef($arg);}; # we need some config here

        if ($cmdlin) {
            $self->{AsAService} = 0;
        } else {
            $self->{AsAService} = 1;
            $self->{ServiceStopping} = 0;
            $main::attr{global}{nofork}=1; # this has to be set here
            push @ServiceLog, 'registering fhem as Windows Service';
            Win32::Daemon::StartService();

            # Wait until the service manager is ready for us to continue...
            my $i = 0;
            while( SERVICE_START_PENDING != Win32::Daemon::State() && $i < 60) {
                # looping indefinitely and waiting to start
                sleep( 1 );
                $i++;
            }
            if ($i > 59) {
                push @ServiceLog,'unable to register fhem in SCM - cancel';
                die "unable to register fhem in SCM - cancel\n";
            }
            Win32::Daemon::State( SERVICE_RUNNING );
            push @ServiceLog,'starting fhem as a service';

            # this sub is called in the main loop to check the service state
            $self->{serviceCheck} = sub {
               return unless $self->{AsAService};
               my $state = Win32::Daemon::State();
               my %idlestate = (
                   Win32::Daemon::SERVICE_PAUSE_PENDING => 1,
                   Win32::Daemon::SERVICE_CONTINUE_PENDING => -1
               );
               if( $state == SERVICE_STOP_PENDING ) {
                   if ($self->{ServiceStopping} == 0) {
                       $self->{ServiceStopping} = 1;
                       &main::Log(1,'service stopping');
                       #ask SCM for a grace time (30 seconds) to shutdown
                       Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 );
                       &main::Log(1, 'service stopped');
                       &main::CommandShutdown(undef, undef);
                       $self->{ServiceStopping} = 2;
                       Win32::Daemon::State( SERVICE_STOPPED );
                       Win32::Daemon::StopService();
                       # be nice, tell we stopped
                       exit 0;
                   } elsif ($self->{ServiceStopping} == 1) {
                       # keep telling SCM we're stopping and didn't hang
                       Win32::Daemon::State( SERVICE_STOP_PENDING, 30000 );
                   }
               } elsif ( $state == SERVICE_PAUSE_PENDING ) {
                   Win32::Daemon::State( SERVICE_PAUSED );
                   $self->{allIdle} = $idlestate{$state};
                   &main::Log(1,'pausing service');
               } elsif ( $state == SERVICE_CONTINUE_PENDING ) {
                   Win32::Daemon::State( SERVICE_RUNNING );
                   $self->{allIdle} = $idlestate{$state};
                   &main::Log(1, 'continue service');
               } else {
                   my $PrevState = SERVICE_RUNNING;
                   $PrevState = SERVICE_STOPPED if $self->{ServiceStopping};
                   $PrevState = SERVICE_PAUSED if $self->{allIdle} > 0;
                   Win32::Daemon::State( $PrevState );
                   undef $self->{allIdle}
                       if ($PrevState == SERVICE_RUNNING);
               }
            };
        } # end if ($cmdlin)
EOT
        if ($@) {   # we got some Perl errors in eval
            push @ServiceLog, "error: $@";
            $self->{serviceCheck} = sub {}; # set it - could be destroyed
            $self->{AsAService} = 0;
        }
        push @ServiceLog,'starting in console mode'
            unless $self->{AsAService};
    } else {
        $self->{AsAService} = 0;
        push @ServiceLog,'starting in console mode';
    }
    return @ServiceLog;
}
###################################################

1;