Seite drucken - [gelöst]System neu aufgestetzt -> FHEM lief -> nach Einspielen des Backup nicht

Titel: [gelöst]System neu aufgestetzt -> FHEM lief -> nach Einspielen des Backup nicht
Beitrag von: Kuetzer am 02 März 2020, 21:16:10

Hallo liebe Community,
erstmal einfach DANKE, dass es euch gibt. In den letzten vier Jahren konnte ich immer ohne einen eigenen Post meine (FHEM-)Problemchen mit meinem rudimentären Halbwissen und vorallem dem Durchstöbern des Forums lösen -> TOP!!!
Nachdem dann vor ein paar Tagen Probleme mit Telegram aufgetreten sind, habe ich mich dazu entsclossen, mein vier Jahre altes System in den Ruhestand zu schicken und neu auf zu setzen.
Aktuelle Stand: Raspi 2B+ mit Buster lite.
Nach der Neuinstallation von FHEM war dies über FHEMWEB erreichbar. Nach Einspielen des Backups war dem leider nicht mehr so.
Ich habe mich dann mal durch die Fehlersuche https://wiki.fhem.de/wiki/FHEM_startet_nicht_-_Tipps_zur_Fehlersuche (https://wiki.fhem.de/wiki/FHEM_startet_nicht_-_Tipps_zur_Fehlersuche) gehangelt. Ich habe dabei folgende Ergebnisse bekommen:
FHEM-Prozess scheint zu laufen:

Code Auswählen

pi@FHEM-Server:~ $ ps ax | grep perl
 1992 ?        R      0:01 /usr/bin/perl fhem.pl fhem.cfg
 1994 pts/0    S+     0:00 grep --color=auto perl

bzw.

Code Auswählen

● fhem.service - FHEM Home Automation
   Loaded: loaded (/etc/systemd/system/fhem.service; enabled; vendor preset: enabled)
   Active: active (running) since Mon 2020-03-02 21:00:57 CET; 2s ago
  Process: 2009 ExecStart=/usr/bin/perl fhem.pl fhem.cfg (code=exited, status=0/SUCCESS)
 Main PID: 2010 (perl)
   Memory: 10.5M
   CGroup: /system.slice/fhem.service
           └─2010 /usr/bin/perl fhem.pl fhem.cfg

Aber anscheinend ist der Prozess ausge-/überlastet:

Code Auswählen

top - 20:17:14 up 37 min,  1 user,  load average: 1,14, 1,14, 1,06
Tasks:  71 total,   2 running,  69 sleeping,   0 stopped,   0 zombie
%Cpu(s): 97,4 us,  2,6 sy,  0,0 ni,  0,0 id,  0,0 wa,  0,0 hi,  0,0 si,  0,0 st
MiB Mem :    432,4 total,    261,5 free,     48,9 used,    122,0 buff/cache
MiB Swap:    100,0 total,    100,0 free,      0,0 used.    328,7 avail Mem

  PID USER      PR  NI    VIRT    RES    SHR S  %CPU  %MEM     TIME+ COMMAND
 1309 fhem      20   0   27820  20216   3996 R  97,1   4,6   0:05.94 perl

Die Dateiberechtigungen sollten stimmen:

Code Auswählen

pi@FHEM-Server:~ $ ls -la /opt/fhem/
insgesamt 800
drwxr-xr-x 12 fhem dialout   4096 Feb 19 23:42 .
drwxr-xr-x  4 root root      4096 Feb 19 23:04 ..
drwxr-xr-x  5 fhem dialout   4096 Jan  4  2019 alexa-fhem
-rw-r--r--  1 fhem dialout  39546 Jan  3  2019 alexa-fhem-0.4.4.tgz
-rw-r--r--  1 fhem dialout    311 Feb 28  2019 alexa-fhem.cfg
-rw-r--r--  1 fhem dialout 325883 Feb 11 21:10 CHANGED
-rw-r--r--  1 fhem dialout  39782 Sep 16 21:55 configDB.pm
drwxr-xr-x 48 fhem dialout   4096 Sep 20  2016 contrib
drwxr-xr-x  3 fhem dialout   4096 Aug  8  2016 demolog
drwxr-xr-x  4 fhem dialout   4096 Sep 10  2017 docs
drwxr-xr-x  2 fhem dialout   4096 Mär  8  2017 ESPEasy
drwxr-xr-x  6 fhem dialout  32768 Feb 11 21:10 FHEM
-rw-r--r--  1 fhem dialout  70487 Feb 19 20:32 fhem.cfg
-rw-r--r--  1 fhem dialout  25544 Jul  9  2019 fhem.cfg.demo
-rwxr-xr-x  1 fhem dialout 159742 Feb 11 21:10 fhem.pl
drwxr-xr-x  2 fhem dialout  20480 Mär  2 19:41 log
-rw-r--r--  1 fhem dialout  42504 Feb 11 21:10 MAINTAINER.txt
-rw-r--r--  1 fhem dialout    935 Nov 15  2015 README_DEMO.txt
drwxr-xr-x  7 fhem dialout   4096 Okt 11  2018 restoreDir
drwxr-xr-x  2 fhem dialout   4096 Aug  8  2016 unused
drwxr-xr-x  8 fhem dialout   4096 Aug  8  2016 www

Ich habe mir dann mal das Logfile angesehen, und da gibt es anscheinend ein Problem:

Code Auswählen

2020.03.02 19:51:07 1: Including fhem.cfg
2020.03.02 19:51:08 3: telnetPort: port 7072 opened
2020.03.02 19:51:10 3: WEB: port 8083 opened
2020.03.02 19:51:10 3: WEBphone: port 8084 opened
2020.03.02 19:51:10 3: WEBtablet: port 8085 opened
2020.03.02 19:51:12 2: eventTypes: loaded 2784 events from ./log/eventTypes.txt
2020.03.02 19:51:17 3: Opening FritzBox_Monitor device 192.168.178.1:1012
2020.03.02 19:51:17 3: Opening CUL_0 device /dev/ttyACM0
2020.03.02 19:51:17 3: Setting CUL_0 serial parameters to 9600,8,N,1
2020.03.02 19:51:17 3: CUL_0: Possible commands: BbCFiAZNkGMKUYRTVWXefmLltux
2020.03.02 19:51:18 3: CUL_0 device opened
Expected 'PeerService' at /usr/share/perl5/Net/SIP/Util.pm line 40.

Diese Meldungen kommen in Endlosschleife und mehr sind es auch nicht.

Der Inhalt der Util.pm sieht wie folgt aus:

Code Auswählen


###########################################################################
# Net::SIP::Util
# various functions for helping in SIP programs
###########################################################################

use strict;
use warnings;

package Net::SIP::Util;

use Digest::MD5 'md5_hex';
use Socket 1.95 qw(
    inet_ntop inet_pton
    AF_INET unpack_sockaddr_in pack_sockaddr_in
    getaddrinfo
);
use Net::SIP::Debug;
use Carp qw(confess croak);
use base 'Exporter';

BEGIN {
    my $mod6 = '';
    if (eval {
	require IO::Socket::IP;
	IO::Socket::IP->VERSION(0.31);
	Socket->import('AF_INET6');
	AF_INET6();
    }) {
	$mod6 = 'IO::Socket::IP';
	*INETSOCK = sub {
	    return IO::Socket::IP->new(@_) if @_ == 1;
	    # Hack to work around the problem that IO::Socket::IP defaults to
	    # AI_ADDRCONFIG which creates problems if we have only the loopback
	    # interface. If we already know the family this flag is more harmful
	    # then useful.
	    my %args = @_;
	    $args{GetAddrInfoFlags} = 0  if ! defined $args{GetAddrInfoFlags}
		and $args{Domain} || $args{Family};
	    return IO::Socket::IP->new(%args);
	};

    } elsif (eval {
	require IO::Socket::INET6;
	IO::Socket::INET6->VERSION(2.62);
	Socket->import('AF_INET6');
	AF_INET6();
    }) {
	$mod6 = 'IO::Socket::INET6';
	*INETSOCK = sub {
	    return IO::Socket::INET6->new(@_) if @_ == 1;
	    my %args = @_;
	    $args{Domain} = delete $args{Family} if exists $args{Family};
	    return IO::Socket::INET6->new(%args);
	};

    } else {
	*INETSOCK = sub { return IO::Socket::INET->new(@_) };
	no warnings 'redefine';
	# Since value differs between platforms we set it to something that
	# should not collide with AF_INET and maybe will even cause inet_ntop
	# etc to croak. In any case this will only be used if CAN_IPV6 is false
	# because otherwise we have the correct value from Socket.
	*AF_INET6 = sub() { -1 };
    }

    *CAN_IPV6 = $mod6 ? sub() { 1 } : sub() { 0 };
    Socket->import(qw(unpack_sockaddr_in6 pack_sockaddr_in6)) if $mod6;
}

our @EXPORT = qw(INETSOCK);
our @EXPORT_OK = qw(
    sip_hdrval2parts sip_parts2hdrval
    sip_uri2parts sip_parts2uri sip_uri_eq sip_uri2sockinfo sip_sockinfo2uri
    laddr4dst create_socket_to create_rtp_sockets
    ip_string2parts ip_parts2string
    ip_parts2sockaddr ip_sockaddr2parts
    ip_sockaddr2string
    ip_is_v4 ip_is_v6 ip_is_v46
    ip_ptr ip_canonical
    hostname2ip
    CAN_IPV6
    invoke_callback
);
our %EXPORT_TAGS = ( all => [ @EXPORT_OK, @EXPORT ] );

our $RTP_MIN_PORT = 2000;
our $RTP_MAX_PORT = 12000;

###########################################################################
# creates hash from header val, e.g.
# 'Digest method="md5",qop="auth",...','www-authenticate' will result in
# ( 'Digest', { method => md5, qop => auth,... } )
# Args: ($key,$val)
#   $key: normalized key (lowercase, long)
#   $val: value
# Returns: ( $data,\%parameter )
#   $data: initial data
#   %parameter: additional parameter
###########################################################################
my %delimiter = (
    'www-authenticate' => ',',
    'proxy-authenticate' => ',',
    'authorization' => ',',
    'proxy-authorization' => ',',
);
sub sip_hdrval2parts {
    croak( "usage: sip_hdrval2parts( key => val )" ) if @_!=2;
    my ($key,$v) = @_;
    return if !defined($v);
    my $delim = $delimiter{$key} || ';';

    # split on delimiter (but not if quoted)
    my @v = ('');
    my $quoted = 0;
    my $bracket = 0;
    while (1) {
	if ( $v =~m{\G(.*?)([\\"<>$delim])}gc ) {
	    if ( $2 eq "\\" ) {
		$v[-1].=$1.$2.substr( $v,pos($v),1 );
		pos($v)++;
	    } elsif ( $2 eq '"' ) {
		$v[-1].=$1.$2;
		$quoted = !$quoted if ! $bracket;
	    } elsif ( $2 eq '<' ) {
		$v[-1].=$1.$2;
		$bracket = 1 if ! $bracket && ! $quoted;
	    } elsif ( $2 eq '>' ) {
		$v[-1].=$1.$2;
		$bracket = 0 if $bracket && ! $quoted;
	    } elsif ( $2 eq $delim ) {
		# next item if not quoted
		if ( ! $quoted && ! $bracket ) {
		    ( $v[-1].=$1 ) =~s{\s+$}{}; # strip trailing space
		    push @v,'' ;
		    $v =~m{\G\s+}gc; # skip space after $delim
		} else {
		    $v[-1].=$1.$2
		}
	    }
	} else {
	    # add rest to last from @v
	    $v[-1].= substr($v,pos($v)||0 );
	    last;
	}
    }

    # with delimiter ',' it starts 'Digest realm=...' so $v[0]
    # contains method and first parameter
    my $data = shift(@v);
    if ( $delim eq ',' ) {
	$data =~s{^(\S+)\s*(.*)}{$1};
	unshift @v,$2;
    }
    # rest will be interpreted as parameters with key|key=value
    my %hash;
    foreach my $vv (@v) {
	my ($key,$value) = split( m{\s*=\s*},$vv,2 );
	if ( defined($value) ) {
	    $value =~s{^"(.*)"$}{$1};  # unquote
	    # TODO Q: what's the meaning of "\%04", e.g. is it
	    # '%04' or "\\\004" ??
	    $value =~s{\\(.)}{$1}sg;   # unescape backslashes
	    $value =~s{%([a-fA-F][a-fA-F])}{ chr(hex($1)) }esg; # resolve uri encoding
	}
	$hash{lc($key)} = $value;
    }
    return ($data,\%hash);
}


###########################################################################
# reverse to sip_hdrval2parts
# Args: ($key,$data,\%parameter)
#   $key: normalized key (lowercase, long)
#   $data: initial data
#   %parameter: additional parameter
# Returns: $val
#   $val: value
###########################################################################
sub sip_parts2hdrval {
    my ($key,$data,$param) = @_;

    my $delim = $delimiter{$key} || ';';

    my $val = $data; # FIXME: need to escape $data?
    for my $k ( sort keys %$param ) {
	$val .= $delim.$k;
	my $v = $param->{$k};
	if ( defined $v ) {
	    # escape special chars
	    $v =~s{([%\r\n\t"[:^print:]])}{ sprintf "%%%02x",ord($1) }esg;
	    $v = '"'.$v.'"' if $v =~m{\s|$delim};
	    $val .= '='.$v
	}
    }
    return $val;
}


###########################################################################
# extract parts from SIP URI
# Args: $uri
# Returns: $domain || ($domain,$user,$proto,$param,$data)
#  $domain: SIP domain maybe with port
#  $user:   user part
#  $proto:  'sip'|'sips'
#  $param:  hashref with params, e.g { transport => 'udp',... }
#  $data:   full part before any params
###########################################################################
sub sip_uri2parts {
    my $uri = shift;
    $uri = $1 if $uri =~m{<([^>]+)>\s*$};
    my ($data,$param) = sip_hdrval2parts( uri => $uri );
    if ( $data =~m{^
	(?: (sips?)     : )?
	(?: ([^\s\@]*) \@ )?
	(
	    \[ [^\]\s]+ \] ( : \w+)?          # [ipv46_or_host]:port
	    | [^:\s]+ ( : \w+)?               # ipv4_or_host:port
	    | (?:[a-f\d]*:){2}[a-f\d\.:]*     # ipv6
	)
    $}ix ) {
	my ($proto,$user,$domain) = ($1,$2,$3);
	$domain = lc($domain);
	$proto ||= 'sip';
	return wantarray
	    ? ($domain,$user,lc($proto),$param,$data)
	    : $domain
    } else {
	return;
    }
}


###########################################################################
# reverse to sip_uri2parts, e.g. construct SIP URI
# Args: ($domain,$user,$proto,$param)
#  $domain: SIP domain maybe with port or [host,port,?family]
#  $user:   user part
#  $proto:  'sip'|'sips' - defaults to 'sip'
#  $param:  hashref with params, e.g { transport => 'udp',... }
# Args: $uri
###########################################################################
sub sip_parts2uri {
    my ($domain,$user,$proto,$param) = @_;
    my $uri = sip_parts2hdrval('uri',
	($proto || 'sip'). ':' 
	. ($user ? $user.'@' : '')
	. (ref($domain) ? ip_parts2string(@$domain) : $domain),
	$param
    );
    return $param && %$param ? "<$uri>" : $uri;
}

###########################################################################
# Extract the parts from a URI which are relevant for creating the socket, i.e
#   sips:host:port
#   sip:host;transport=TCP
# Args: $uri,?$opaque
#   $uri:  SIP URI
#   $opaque: don't enforce that host part of URI looks like hostname or IP
# Returns: ($proto,$host,$port,$family)
#   $proto: udp|tcp|tls|undef
#   $host: ip or hostname from URI
#   $port: port from URI
#   $family: family matching $host, i.e. AF_INET|AF_INET6|undef
###########################################################################
sub sip_uri2sockinfo {
    my ($domain,undef,$proto,$param)  = sip_uri2parts(shift())
	or return;
    $proto =
	($proto && $proto eq 'sips') ? 'tls' :           # sips -> tls
	$param->{transport} ? lc($param->{transport}) :  # transport -> tcp|udp
	undef;                                           # not restricted
    return ($proto, ip_string2parts($domain, shift()));
}

###########################################################################
# Reverse to sip_uri2sockinfo
# Args: (\%hash|$proto,$host,$port,$family)
#   $proto: udp|tcp|tls|undef
#   $host: ip or hostname from URI
#   $port: port from URI
#   $family: family matching $host, i.e. AF_INET|AF_INET6|undef
#   %hash: hash with keys proto, host, port, family
# Returns: $uri
###########################################################################
sub sip_sockinfo2uri {
    my ($proto,$host,$port,$family) = ref($_[0])
	? @{$_[0]}{qw(proto host port family)}
	: @_;
    return sip_parts2uri(
	ip_parts2string($host,$port,$family),
	undef,
	!defined $proto ? ('sip',  {}) :
	$proto eq 'tls' ? ('sips', {}) :
	$proto eq 'tcp' ? ('sip',  { transport => 'TCP' }) :
	$proto eq 'udp' ? ('sip',  {}) :
	die "invalid proto: '$proto'"
    )
}

###########################################################################
# returns true if two URIs are the same
# Args: $uri1,$uri2
# Returns: true if both URI point to same address
###########################################################################
sub sip_uri_eq {
    my ($uri1,$uri2) = @_;
    return 1 if $uri1 eq $uri2; # shortcut for common case
    my ($d1,$u1,$p1) = sip_uri2parts($uri1);
    my ($d2,$u2,$p2) = sip_uri2parts($uri2);
    my $port1 = $d1 =~s{:(\d+)$|\[(\d+)\]$}{} ? $1||$2
	: $p1 eq 'sips' ? 5061 : 5060;
    my $port2 = $d2 =~s{:(\d+)$|\[(\d+)\]$}{} ? $1||$2
	: $p2 eq 'sips' ? 5061 : 5060;
    return lc($d1) eq lc($d2)
	&& $port1 == $port2
	&& ( defined($u1) ? defined($u2) && $u1 eq $u2 : ! defined($u2))
	&& $p1 eq $p2;
}

###########################################################################
# fid out local address which is used when connecting to destination
# Args: ($dst,@src)
#  $dst: target IP (or ip:port)
#  @src: optional list of source IP to try, if not given will use any source
# Return: $ip|($ip,$family) - source IP used when reaching destination
# Comment:
#  A UDP socket will be created and connected and then the local address
#  read from the socket. It is expected that the OS kernel will fill in
#  the local address when connecting even though no packets are actually
#  send to the peer
###########################################################################
sub laddr4dst {
    my ($dst,@src) = @_;
    my ($addr, $port, $fam) = ip_string2parts($dst);
    $fam or return;  # no IP destination
    for my $src (@src ? @src : (undef)) {
	my $sock = INETSOCK(
	    Proto => 'udp',
	    Family => $fam,
	    PeerAddr => $addr,
	    PeerPort => $port || 5060,
	    $src ? (LocalAddr => $src) : (),
	) or next;
	my @parts = ip_sockaddr2parts(getsockname($sock));
	return wantarray ? @parts[0,2] : $parts[0];
    }
    return; # no route
}

###########################################################################
# create socket preferable on port 5060 from which one might reach the given IP
# Args: ($dst_addr;$proto)
#  $dst_addr: the adress which must be reachable from this socket
#  $proto: udp|tcp|tls, default udp
# Returns: ($sock,$ip_port) || $sock || ()
#  $sock: the created socket
#  $ip_port: ip:port of socket, only given if called in array context
# Comment: the IP it needs to come from works by creating a udp socket
#  to this host and figuring out it's IP by calling getsockname. Then it
#  tries to create a socket on this IP using port 5060/5061 and if this does
#  not work it tries the port 5062..5100 and if this does not work too
#  it let the system use a random port
#  If creating of socket fails it returns () and $! is set
###########################################################################
sub create_socket_to {
    my ($dst_addr,$proto) = @_;
    $proto ||= 'udp';

    my ($laddr,$fam) = laddr4dst($dst_addr);
    DEBUG( "Local IP is $laddr" );

    # Bind to this IP
    # First try port 5060..5100, if they are all used use any port
    # I get from the system
    for my $p ( $proto eq 'tls' ? 5061:5060, 5062..5100, 0 ) {
	$DEBUG && DEBUG( "try to listen on %s",
	    ip_parts2string($laddr,$p,$fam));
	my $sock = INETSOCK(
	    Family => $fam,
	    LocalAddr => $laddr,
	    $p ? (LocalPort => $p) : (),
	    Proto => $proto eq 'tls' ? 'tcp' : $proto,
	) or next;

	my $port = $p || (ip_sockaddr2parts(getsockname($sock)))[1];
	$DEBUG && DEBUG("listen on %s",ip_parts2string($laddr,$port,$fam));
	return $sock if ! wantarray;
	return ($sock,ip_parts2string($laddr,$port,$fam));
    }
    die "even binding to port 0 failed: $!";
}

###########################################################################
# create RTP/RTCP sockets
# Args: ($laddr;$range,$min,$max,$tries)
#   $laddr: local addr
#   $range: how many sockets, 2 if not defined
#   $min: minimal port number, default $RTP_MIN_PORT
#   $max: maximal port number, default 10000 more than $min
#      or $RTP_MAX_PORT if $min not given
#   $tries: how many tries, default 100
# Returns: ($port,$rtp_sock,$rtcp_sock,@more_socks)
#   $port:      port of RTP socket, port for RTCP is port+1
#   $rtp_sock:  socket for RTP data
#   $rtcp_sock: socket for RTCP data
#   @more_socks: more sockets (if range >2)
###########################################################################
sub create_rtp_sockets {
    my ($laddr,$range,$min,$max,$tries) = @_;
    $range ||= 2;
    if ( ! $min ) {
	$min = $RTP_MIN_PORT;
	$max ||= $RTP_MAX_PORT;
    } else {
	$max ||= $min+10000;
    }
    $min += $min%2; # make even
    $tries ||= 1000;

    my $diff2 = int(($max-$min)/2) - $range +1;

    my (@socks,$port);
    my $fam = (ip_string2parts($laddr))[2];
    while ( $tries-- >0 ) {

	last if @socks == $range;
	close $_ for @socks;
	@socks = ();

	$port = 2*int(rand($diff2)) + $min;
	for( my $i=0;$i<$range;$i++ ) {
	    push @socks, INETSOCK(
		Family => $fam,
		Proto => 'udp',
		LocalAddr => $laddr,
		LocalPort => $port + $i,
	    ) || last;
	}
    }
    return if @socks != $range; # failed
    return ($port,@socks);
}

###########################################################################
# helper to call callback, set variable..
# Args: ($cb;@args)
#  $cb:  callback
#  @args: additional args for callback
# Returns: $rv
#  $rv: return value of callback
# Comment:
# callback can be
# - code ref: will be called with $cb->(@args)
# - object with method run, will be called with $cb->run(@args)
# - array-ref with [ \&sub,@myarg ], will be called with $sub->(@myarg,@args)
# - scalar ref: the scalar will be set to $args[0] if @args, otherwise true
# - regex: returns true if anything in @args matches regex
###########################################################################
sub invoke_callback {
    my ($cb,@more_args) = @_;
    if ( UNIVERSAL::isa( $cb,'CODE' )) {
	# anon sub
	return $cb->(@more_args)
    } elsif ( my $sub = UNIVERSAL::can( $cb,'run' )) {
	# Callback object
	return $sub->($cb,@more_args );
    } elsif ( UNIVERSAL::isa( $cb,'ARRAY' )) {
	my ($sub,@args) = @$cb;
	# [ \&sub,@arg ]
	return $sub->( @args,@more_args );
    } elsif ( UNIVERSAL::isa( $cb,'Regexp' )) {
	@more_args or return;
	for(@more_args) {
	    return 1 if m{$cb}
	}
	return 0;
    } elsif ( UNIVERSAL::isa( $cb,'SCALAR' ) || UNIVERSAL::isa( $cb,'REF' )) {
	# scalar ref, set to true
	$$cb = @more_args ? shift(@more_args) : 1;
	return $$cb;
    } elsif ( $cb ) {
	confess "unknown handler $cb";
    }
}

###########################################################################
# split string into host/ip, port and detect family (IPv4 or IPv6)
# Args: $addr;$opaque
#  $addr: ip_or_host, ipv4_or_host:port, [ip_or_host]:port
#  $opaque: optional argument, if true it will not enforce valid syntax
#     for the hostname and will not return canonicalized data
# Returns: (\%hash|$host,$port,$family)
#  $host:   canonicalized IP address or hostname
#  $port:   the port or undef if no port was given in string
#  $family: AF_INET or AF_INET6 or undef (hostname not IP given)
#  %hash:   hash with addr, port, family - used if !wantarray
###########################################################################
sub ip_string2parts {
    my ($addr,$opaque) = @_;
    my ($host,$port,$family);
    if ($addr =~m{:[^:\s]*(:)?}) {
	if (!$1) {
	    # (ipv4|host):port
	    ($host,$port) = split(':',$addr,2);
	    $family = AF_INET;
	} elsif ($addr =~m{^\[(?:(.*:.*)|([^:]*))\](?::(\w+))?\z}) {
	    $port = $3;
	    ($host,$family) = $1
		? ($1, AF_INET6) # [ipv6](:port)?
		: ($2, AF_INET); # [ipv4|host](:port)?
	} else {
	    # ipv6
	    ($host,$family) = ($addr, AF_INET6);
	}
    } else {
	# ipv4|host
	($host,$family) = ($addr, AF_INET);
    }

    # we now have:
    # AF_INET6 if it contains a ':', i.e. either valid IPv6 or smthg invalid
    # AF_INET  otherwise, i.e. IPv4 or hostname or smthg invalid

    # check if this is an IP address from the expected family
    if ($addr = inet_pton($family,$host)) {
	# valid IP address
	$addr = $opaque ? $host
	    : inet_ntop($family, $addr); # canonicalized form
    } elsif ($opaque) {
	# not a valid IP address - pass through because opaque
	$family = $addr = undef;
    } elsif ($host =~m{^[a-z\d\-\_]+(?:\.[a-z\d\-\_]+)*\.?\z}) {
	# not a valid IP address but valid hostname
	$family = $addr = undef;
    } else {
	# neither IP nor valid hostname
	Carp::confess("invalid hostname '$host' in '$_[0]'");
	die("invalid hostname '$host' in '$_[0]'");
    }

    # make sure that it looks like a valid hostname and return it lower case
    $host = lc($host) if ! $opaque;
    return ($host,$port,$family) if wantarray;
    return {
	host   => $host,
	addr   => $addr,
	port   => $port,
	family => $family
    };

}

###########################################################################
# concat ip/host and port to string, i.e. reverse to ip_string2parts
# Args: ($host;$port,$family,$ipv6_brackets)
#  $host:   the IP address or hostname
#  $port:   optional port
#  $family: optional, will be detected from $host if not given
#  $ipv6_brackets: optional, results in [ipv6] if true and no port given
# alternative Args: (\%hash,$ipv6_brackets)
#  %hash:   hash containing addr|host, port and family
#           if opt default_port is given will treat port as 0 if default
#           if opt use_host is true will prefer host instead of addr
# Returns: $addr
#  $addr: ip_or_host, ipv4_or_host:port, [ipv6]:port,
#         [ipv6] (if ipv6_brackets)
###########################################################################
sub ip_parts2string {
    my ($host,$port,$fam,$ipv6_brackets);
    if (ref($_[0])) {
	(my $hash,$ipv6_brackets) = @_;
	$port = $hash->{port};
	$fam  = $hash->{family};
	$host = $hash->{addr} || $hash->{host};
	if (exists $hash->{use_host} && $hash->{use_host}
	    && $hash->{host} && $fam && $hash->{host} ne $hash->{addr}) {
	    # use host instead of addr and set family to undef in order to
	    # not put hostname in brackets
	    $host = $hash->{host};
	    $fam = undef;
	}
	if (exists $hash->{default_port} && $port == $hash->{default_port}) {
	    $port = 0;
	}
    } else {
	($host,$port,$fam,$ipv6_brackets) = @_;
    }
    $host = lc($host);
    return $host if ! $port && !$ipv6_brackets;
    $fam ||= $host =~m{:} && AF_INET6;

    $host = "[$host]" if $fam && $fam != AF_INET;
    return $host if ! $port;
    return $host.':'.$port;
}

###########################################################################
# create sockaddr from IP, port (and family)
# Args: ($addr,$port;$family)
#  $addr:   the IP address
#  $port:   port
#  $family: optional, will be detected from $ip if not given
# alternative Args: \%hash
#  %hash: hash with addr, port, family
# Returns: $sockaddr
###########################################################################
sub ip_parts2sockaddr {
    my ($addr,$port,$fam);
    if (ref($_[0])) {
	$addr = $_[0]->{addr};
	$port = $_[0]->{port};
	$fam  = $_[0]->{family};
    } else {
	($addr,$port,$fam) = @_;
    }
    $fam ||= $addr =~m{:} ? AF_INET6 : AF_INET;
    if ($fam == AF_INET) {
	return pack_sockaddr_in($port,inet_pton(AF_INET,$addr))
    } elsif (CAN_IPV6) {
	return pack_sockaddr_in6($port,inet_pton(AF_INET6,$addr))
    } else {
	die "no IPv6 support"
    }
}

###########################################################################
# create parts from sockaddr, i.e. reverse to ip_parts2sockaddr
# Args: $sockaddr;$family
#  $sockaddr: sockaddr as returned by getsockname, recvfrom..
#  $family: optional family, otherwise guessed based on size of sockaddr
# Returns: (\%hash | $ip,$port,$family)
#  $ip:     the IP address
#  $port:   port
#  $family: AF_INET or AF_INET6
#  %hash: hash with host, addr, port, family - if not wantarray
###########################################################################
sub ip_sockaddr2parts {
    my ($sockaddr,$fam) = @_;
    $fam ||= length($sockaddr)>=24 ? AF_INET6 : AF_INET;
    die "no IPv6 support" if $fam != AF_INET && !CAN_IPV6;
    my ($port,$addr) = $fam == AF_INET
	? unpack_sockaddr_in($sockaddr)
	: unpack_sockaddr_in6($sockaddr);
    $addr = inet_ntop($fam,$addr);
    return ($addr,$port,$fam) if wantarray;
    return {
	host   => $addr,
	addr   => $addr,
	port   => $port,
	family => $fam,
    };
}

###########################################################################
# gets string from sockaddr, i.e. like ip_parts2string(ip_sockaddr2parts(..))
# Args: $sockaddr;$family
#  $sockaddr: sockaddr as returned by getsockname, recvfrom..
#  $family: optional family, otherwise guessed based on size of sockaddr
# Returns: $string
###########################################################################
sub ip_sockaddr2string {
    my ($sockaddr,$fam) = @_;
    $fam ||= length($sockaddr)>=24 ? AF_INET6 : AF_INET;
    if ($fam == AF_INET) {
	my ($port,$addr) = unpack_sockaddr_in($sockaddr);
	return inet_ntop(AF_INET,$addr) . ":$port";
    } else {
	my ($port,$addr) = unpack_sockaddr_in6($sockaddr);
	return '[' . inet_ntop(AF_INET6,$addr) . "]:$port";
    }
}

###########################################################################
# return name for PTR lookup of given IP address
# Args: $ip;$family
#  $ip: IP address
#  $family: optional family
# Returns: $ptr_name
###########################################################################
sub ip_ptr {
    my ($ip,$family) = @_;
    $family ||= $ip=~m{:} ? AF_INET6 : AF_INET;
    if ($family == AF_INET) {
	return join('.', reverse(unpack("C*",inet_pton(AF_INET,$ip))))
	    . '.in-addr.arpa';
    } else {
	return join('.', reverse(split('',
	    unpack("H*", inet_pton(AF_INET6,$ip)))))
	    . '.ip6.arpa';
    }
}

###########################################################################
# convert IP address into canonical form suitable for comparison
# Args: $ip;$family
#  $ip: IP address
#  $family: optional family
# Returns: $ip_canonical
###########################################################################
sub ip_canonical {
    my ($ip,$family) = @_;
    $family ||= $ip=~m{:} ? AF_INET6 : AF_INET;
    return inet_ntop($family, inet_pton($family, $ip));
}

###########################################################################
# get IP addresses for hostname
# Args: ($name;$family)
#  $name: hostname
#  $family: optional family to restrict result to IPv4/IPv6
# Returns: @ip | $ip - i.e. list of IP or first of the list
###########################################################################
sub hostname2ip {
    my ($name,$family) = @_;
    $family = AF_INET if ! $family && ! CAN_IPV6;
    my ($err,@result) = getaddrinfo($name,undef,
	$family ? ({ family => $family }):() );
    return if $err || ! @result;
    @result = $result[0] if ! wantarray;
    ($_) = ip_sockaddr2parts($_->{addr},$_->{family}) for @result;
    return wantarray ? @result : $result[0]
}

###########################################################################
# check if address is valid IPv4 or IPv6 address
# Args: $ip
# Returns: true|false
###########################################################################
sub ip_is_v4  { inet_pton(AF_INET,  $_[0]) }
sub ip_is_v6  { inet_pton(AF_INET6, $_[0]) }

###########################################################################
# check if address is valid IP address
# Args: $ip
# Returns: AF_INET|AF_INET6|undef
###########################################################################
sub ip_is_v46 {
    return
	inet_pton(AF_INET,  $_[0]) ? AF_INET  :
	inet_pton(AF_INET6, $_[0]) ? AF_INET6 :
	undef;
}

1;

Kann mir vielleicht jemand hier bitte weiterhelfen?

Vielen, vielen Dank
Kuetzer

Titel: Antw:System neu aufgestetzt -> FHEM lief -> nach Einspielen des Backup nicht mehr
Beitrag von: JensS am 04 März 2020, 19:39:52

Hi Kuetzer,

kommentiere mal das SIP-Device aus. Vielleicht hilft's.

Gruß Jens

Titel: Antw:System neu aufgestetzt -> FHEM lief -> nach Einspielen des Backup nicht mehr
Beitrag von: Wzut am 04 März 2020, 20:09:04

die Zeile 40 müsste die sein :

Code Auswählen

return IO::Socket::IP->new(%args);
hast denn libio-socket-ip-perl installiert ?

Titel: Antw:System neu aufgestetzt -> FHEM lief -> nach Einspielen des Backup nicht mehr
Beitrag von: Kuetzer am 04 März 2020, 20:18:48

Hi Wzut,
ja, die war schon installiert. Ich hab mal den Tip von Jens befolgt und in der fhem.cfg das Sip-Device auskommentiert. Jetz läßt sich FHMEWEB wieder erreichen :)
Gut, ein paar Baustellen sind noch zu beackern, aber das sollte ich hinbekommen.
Vielen Dank für die Tips!

Gruß Jörg

FHEM Forum

FHEM => Anfängerfragen => Thema gestartet von: Kuetzer am 02 März 2020, 21:16:10