ping.pm

视频监控网络部分的协议ddns,的模块的实现代码,请大家大胆指正.

      $from_port,         # Port message was echoed from
      $from_ip            # Packed IP number of sender
      );

  $saddr = sockaddr_in($self->{"port_num"}, $ip);
  $self->{"seq"} = ($self->{"seq"} + 1) % 256;    # Increment sequence
  $msg = chr($self->{"seq"}) . $self->{"data"};   # Add data if any

  if ($self->{"connected"}) {
    if ($self->{"connected"} ne $saddr) {
      # Still connected to wrong destination.
      # Need to flush out the old one.
      $flush = 1;
    }
  } else {
    # Not connected yet.
    # Need to connect() before send()
    $connect = 1;
  }

  # Have to connect() and send() instead of sendto()
  # in order to pick up on the ECONNREFUSED setting
  # from recv() or double send() errno as utilized in
  # the concept by rdw @ perlmonks.  See:
  # http://perlmonks.thepen.com/42898.html
  if ($flush) {
    # Need to socket() again to flush the descriptor
    # This will disconnect from the old saddr.
    socket($self->{"fh"}, PF_INET, SOCK_DGRAM,
           $self->{"proto_num"});
  }
  # Connect the socket if it isn't already connected
  # to the right destination.
  if ($flush || $connect) {
    connect($self->{"fh"}, $saddr);               # Tie destination to socket
    $self->{"connected"} = $saddr;
  }
  send($self->{"fh"}, $msg, UDP_FLAGS);           # Send it

  $rbits = "";
  vec($rbits, $self->{"fh"}->fileno(), 1) = 1;
  $ret = 0;                   # Default to unreachable
  $done = 0;
  my $retrans = 0.01;
  my $factor = $self->{"retrans"};
  $finish_time = &time() + $timeout;       # Ping needs to be done by then
  while (!$done && $timeout > 0)
  {
    if ($factor > 1)
    {
      $timeout = $retrans if $timeout > $retrans;
      $retrans*= $factor; # Exponential backoff
    }
    $nfound  = mselect((my $rout=$rbits), undef, undef, $timeout); # Wait for response
    my $why = $!;
    $timeout = $finish_time - &time();   # Get remaining time

    if (!defined($nfound))  # Hmm, a strange error
    {
      $ret = undef;
      $done = 1;
    }
    elsif ($nfound)         # A packet is waiting
    {
      $from_msg = "";
      $from_saddr = recv($self->{"fh"}, $from_msg, 1500, UDP_FLAGS);
      if (!$from_saddr) {
        # For example an unreachable host will make recv() fail.
        if (!$self->{"econnrefused"} &&
            ($! == ECONNREFUSED ||
             $! == ECONNRESET)) {
          # "Connection refused" means reachable
          # Good, continue
          $ret = 1;
        }
        $done = 1;
      } else {
        ($from_port, $from_ip) = sockaddr_in($from_saddr);
        if (!$source_verify ||
            (($from_ip eq $ip) &&        # Does the packet check out?
             ($from_port == $self->{"port_num"}) &&
             ($from_msg eq $msg)))
        {
          $ret = 1;       # It's a winner
          $done = 1;
        }
      }
    }
    elsif ($timeout <= 0)              # Oops, timed out
    {
      $done = 1;
    }
    else
    {
      # Send another in case the last one dropped
      if (send($self->{"fh"}, $msg, UDP_FLAGS)) {
        # Another send worked?  The previous udp packet
        # must have gotten lost or is still in transit.
        # Hopefully this new packet will arrive safely.
      } else {
        if (!$self->{"econnrefused"} &&
            $! == ECONNREFUSED) {
          # "Connection refused" means reachable
          # Good, continue
          $ret = 1;
        }
        $done = 1;
      }
    }
  }
  return $ret;
}

# Description: Send a TCP SYN packet to host specified.
sub ping_syn
{
  my $self = shift;
  my $host = shift;
  my $ip = shift;
  my $start_time = shift;
  my $stop_time = shift;

  if ($syn_forking) {
    return $self->ping_syn_fork($host, $ip, $start_time, $stop_time);
  }

  my $fh = FileHandle->new();
  my $saddr = sockaddr_in($self->{"port_num"}, $ip);

  # Create TCP socket
  if (!socket ($fh, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
    croak("tcp socket error - $!");
  }

  if (defined $self->{"local_addr"} &&
      !CORE::bind($fh, sockaddr_in(0, $self->{"local_addr"}))) {
    croak("tcp bind error - $!");
  }

  if ($self->{'device'}) {
    setsockopt($fh, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
      or croak("error binding to device $self->{'device'} $!");
  }
  if ($self->{'tos'}) {
    setsockopt($fh, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
      or croak "error configuring tos to $self->{'tos'} $!";
  }
  # Set O_NONBLOCK property on filehandle
  $self->socket_blocking_mode($fh, 0);

  # Attempt the non-blocking connect
  # by just sending the TCP SYN packet
  if (connect($fh, $saddr)) {
    # Non-blocking, yet still connected?
    # Must have connected very quickly,
    # or else it wasn't very non-blocking.
    #warn "WARNING: Nonblocking connect connected anyway? ($^O)";
  } else {
    # Error occurred connecting.
    if ($! == EINPROGRESS || ($^O eq 'MSWin32' && $! == EWOULDBLOCK)) {
      # The connection is just still in progress.
      # This is the expected condition.
    } else {
      # Just save the error and continue on.
      # The ack() can check the status later.
      $self->{"bad"}->{$host} = $!;
    }
  }

  my $entry = [ $host, $ip, $fh, $start_time, $stop_time ];
  $self->{"syn"}->{$fh->fileno} = $entry;
  if ($self->{"stop_time"} < $stop_time) {
    $self->{"stop_time"} = $stop_time;
  }
  vec($self->{"wbits"}, $fh->fileno, 1) = 1;

  return 1;
}

sub ping_syn_fork {
  my ($self, $host, $ip, $start_time, $stop_time) = @_;

  # Buggy Winsock API doesn't allow nonblocking connect.
  # Hence, if our OS is Windows, we need to create a separate
  # process to do the blocking connect attempt.
  my $pid = fork();
  if (defined $pid) {
    if ($pid) {
      # Parent process
      my $entry = [ $host, $ip, $pid, $start_time, $stop_time ];
      $self->{"syn"}->{$pid} = $entry;
      if ($self->{"stop_time"} < $stop_time) {
        $self->{"stop_time"} = $stop_time;
      }
    } else {
      # Child process
      my $saddr = sockaddr_in($self->{"port_num"}, $ip);

      # Create TCP socket
      if (!socket ($self->{"fh"}, PF_INET, SOCK_STREAM, $self->{"proto_num"})) {
        croak("tcp socket error - $!");
      }

      if (defined $self->{"local_addr"} &&
          !CORE::bind($self->{"fh"}, sockaddr_in(0, $self->{"local_addr"}))) {
        croak("tcp bind error - $!");
      }

      if ($self->{'device'}) {
        setsockopt($self->{"fh"}, SOL_SOCKET, SO_BINDTODEVICE(), pack("Z*", $self->{'device'}))
          or croak("error binding to device $self->{'device'} $!");
      }
      if ($self->{'tos'}) {
        setsockopt($self->{"fh"}, SOL_IP, IP_TOS(), pack("I*", $self->{'tos'}))
          or croak "error configuring tos to $self->{'tos'} $!";
      }

      $!=0;
      # Try to connect (could take a long time)
      connect($self->{"fh"}, $saddr);
      # Notify parent of connect error status
      my $err = $!+0;
      my $wrstr = "$$ $err";
      # Force to 16 chars including \n
      $wrstr .= " "x(15 - length $wrstr). "\n";
      syswrite($self->{"fork_wr"}, $wrstr, length $wrstr);
      exit;
    }
  } else {
    # fork() failed?
    die "fork: $!";
  }
  return 1;
}

# Description: Wait for TCP ACK from host specified
# from ping_syn above.  If no host is specified, wait
# for TCP ACK from any of the hosts in the SYN queue.
sub ack
{
  my $self = shift;

  if ($self->{"proto"} eq "syn") {
    if ($syn_forking) {
      my @answer = $self->ack_unfork(shift);
      return wantarray ? @answer : $answer[0];
    }
    my $wbits = "";
    my $stop_time = 0;
    if (my $host = shift) {
      # Host passed as arg
      if (exists $self->{"bad"}->{$host}) {
        if (!$self->{"econnrefused"} &&
            $self->{"bad"}->{ $host } &&
            (($! = ECONNREFUSED)>0) &&
            $self->{"bad"}->{ $host } eq "$!") {
          # "Connection refused" means reachable
          # Good, continue
        } else {
          # ECONNREFUSED means no good
          return ();
        }
      }
      my $host_fd = undef;
      foreach my $fd (keys %{ $self->{"syn"} }) {
        my $entry = $self->{"syn"}->{$fd};
        if ($entry->[0] eq $host) {
          $host_fd = $fd;
          $stop_time = $entry->[4]
            || croak("Corrupted SYN entry for [$host]");
          last;
        }
      }
      croak("ack called on [$host] without calling ping first!")
        unless defined $host_fd;
      vec($wbits, $host_fd, 1) = 1;
    } else {
      # No $host passed so scan all hosts
      # Use the latest stop_time
      $stop_time = $self->{"stop_time"};
      # Use all the bits
      $wbits = $self->{"wbits"};
    }

    while ($wbits !~ /^\0*\z/) {
      my $timeout = $stop_time - &time();
      # Force a minimum of 10 ms timeout.
      $timeout = 0.01 if $timeout <= 0.01;

      my $winner_fd = undef;
      my $wout = $wbits;
      my $fd = 0;
      # Do "bad" fds from $wbits first
      while ($wout !~ /^\0*\z/) {
        if (vec($wout, $fd, 1)) {
          # Wipe it from future scanning.
          vec($wout, $fd, 1) = 0;
          if (my $entry = $self->{"syn"}->{$fd}) {
            if ($self->{"bad"}->{ $entry->[0] }) {
              $winner_fd = $fd;
              last;
            }
          }
        }
        $fd++;
      }

      if (defined($winner_fd) or my $nfound = mselect(undef, ($wout=$wbits), undef, $timeout)) {
        if (defined $winner_fd) {
          $fd = $winner_fd;
        } else {
          # Done waiting for one of the ACKs
          $fd = 0;
          # Determine which one
          while ($wout !~ /^\0*\z/ &&
                 !vec($wout, $fd, 1)) {
            $fd++;
          }
        }
        if (my $entry = $self->{"syn"}->{$fd}) {
          # Wipe it from future scanning.
          delete $self->{"syn"}->{$fd};
          vec($self->{"wbits"}, $fd, 1) = 0;
          vec($wbits, $fd, 1) = 0;
          if (!$self->{"econnrefused"} &&
              $self->{"bad"}->{ $entry->[0] } &&
              (($! = ECONNREFUSED)>0) &&
              $self->{"bad"}->{ $entry->[0] } eq "$!") {
            # "Connection refused" means reachable
            # Good, continue
          } elsif (getpeername($entry->[2])) {
            # Connection established to remote host
            # Good, continue
          } else {
            # TCP ACK will never come from this host
            # because there was an error connecting.

            # This should set $! to the correct error.
            my $char;
            sysread($entry->[2],$char,1);
            # Store the excuse why the connection failed.
            $self->{"bad"}->{$entry->[0]} = $!;
            if (!$self->{"econnrefused"} &&
                (($! == ECONNREFUSED) ||
                 ($! == EAGAIN && $^O =~ /cygwin/i))) {
              # "Connection refused" means reachable
              # Good, continue
            } else {
              # No good, try the next socket...
              next;
            }
          }
          # Everything passed okay, return the answer
          return wantarray ?
            ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]))
            : $entry->[0];
        } else {
          warn "Corrupted SYN entry: unknown fd [$fd] ready!";
          vec($wbits, $fd, 1) = 0;
          vec($self->{"wbits"}, $fd, 1) = 0;
        }
      } elsif (defined $nfound) {
        # Timed out waiting for ACK
        foreach my $fd (keys %{ $self->{"syn"} }) {
          if (vec($wbits, $fd, 1)) {
            my $entry = $self->{"syn"}->{$fd};
            $self->{"bad"}->{$entry->[0]} = "Timed out";
            vec($wbits, $fd, 1) = 0;
            vec($self->{"wbits"}, $fd, 1) = 0;
            delete $self->{"syn"}->{$fd};
          }
        }
      } else {
        # Weird error occurred with select()
        warn("select: $!");
        $self->{"syn"} = {};
        $wbits = "";
      }
    }
  }
  return ();
}

sub ack_unfork {
  my ($self,$host) = @_;
  my $stop_time = $self->{"stop_time"};
  if ($host) {
    # Host passed as arg
    if (my $entry = $self->{"good"}->{$host}) {
      delete $self->{"good"}->{$host};
      return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
    }
  }

  my $rbits = "";
  my $timeout;

  if (keys %{ $self->{"syn"} }) {
    # Scan all hosts that are left
    vec($rbits, fileno($self->{"fork_rd"}), 1) = 1;
    $timeout = $stop_time - &time();
    # Force a minimum of 10 ms timeout.
    $timeout = 0.01 if $timeout < 0.01;
  } else {
    # No hosts left to wait for
    $timeout = 0;
  }

  if ($timeout > 0) {
    my $nfound;
    while ( keys %{ $self->{"syn"} } and
           $nfound = mselect((my $rout=$rbits), undef, undef, $timeout)) {
      # Done waiting for one of the ACKs
      if (!sysread($self->{"fork_rd"}, $_, 16)) {
        # Socket closed, which means all children are done.
        return ();
      }
      my ($pid, $how) = split;
      if ($pid) {
        # Flush the zombie
        waitpid($pid, 0);
        if (my $entry = $self->{"syn"}->{$pid}) {
          # Connection attempt to remote host is done
          delete $self->{"syn"}->{$pid};
          if (!$how || # If there was no error connecting
              (!$self->{"econnrefused"} &&
               $how == ECONNREFUSED)) {  # "Connection refused" means reachable
            if ($host && $entry->[0] ne $host) {
              # A good connection, but not the host we need.
              # Move it from the "syn" hash to the "good" hash.
              $self->{"good"}->{$entry->[0]} = $entry;
              # And wait for the next winner
              next;
            }
            return ($entry->[0], &time() - $entry->[3], inet_ntoa($entry->[1]));
          }
        } else {
          # Should never happen
          die "Unknown ping from pid [$pid]";
        }
      } else {
        die "Empty response from status socket?";
      }