view release on metacpan or  search on metacpan

examples/rxdebug  view on Meta::CPAN

  print "\n******** TEST 12 ********\n";

  print "\nrxdebug -servers $servers -port $port -allconnections -onlyclient -onlyport $onlyport -onlyhost $onlyhost\n\n";

  $rxdeb = rxdebug(allconnections => 1,
                   onlyclient     => 1,
                   onlyport       => $onlyport,
                   servers        => $servers,
                   port           => $port,
                   onlyhost       => $onlyhost
                  );
  parse_results ($rxdeb);
}

if ($all || $tests[13]) {
  print "\n******** TEST 13 ********\n";

  print "\nrxdebug -servers $servers\n\n";

  $rxdeb = rxdebug(servers => $servers);
  parse_results ($rxdeb);
}

if ($all || $tests[14]) {
  print "\n******** TEST 14 ********\n";

  print "\nrxdebug 0\n\n";

  $rxdeb = rxdebug();
  parse_results ($rxdeb);
}

if ($all || $tests[15]) {
  print "\n******** TEST 15 ********\n";

  print "\nrxdebug 0 -port $port\n\n";

  $rxdeb = rxdebug(port => $port);
  parse_results ($rxdeb);
}

if ($all || $tests[16]) {
  print "\n******** TEST 16 ********\n";

  print "\nrxdebug -servers $servers -port $port -allconnections -peers -long -rxstats\n\n";

  $rxdeb = rxdebug(allconnections => 1,
                   rxstats        => 1,
                   peers          => 1,
                   long           => 1,
                   servers        => $servers,
                   port           => $port
                  );
  parse_results($rxdeb);
}


sub parse_results {
  my $val = shift;

  # if there was an error, print it and then return.
  if ($AFS::CODE) {
    print "Error case: ", ref($val), "\n" if (defined($val));
    # die("Error: AFS::CODE = $AFS::CODE (", ($AFS::CODE+0), ")\n");
    print "Error: AFS::CODE = $AFS::CODE (", ($AFS::CODE+0), ")\n";
    return;
  }

  # print entire hash to screen
  if ($showdump) {
    print Dumper($val);
    return;
  }

  # print ip address and port
  print "For ", $val->{address}, " (port ", $val->{port}, ") ...\n";

  # prints everything as the rxdebug function would

  # print version if it was returned
  if (exists $val->{version}) {
    print "AFS version: ", $val->{version}, "\n";
  }

  # print tstats if they were returned
  if (exists $val->{tstats}) {
    print "Free packets: $val->{tstats}->{nFreePackets}, ";
    print "packet reclaims: $val->{tstats}->{packetReclaims}, ";
    print "calls: $val->{tstats}->{callsExecuted}, ";
    print "used FDs: $val->{tstats}->{usedFDs}\n";
    if (!$val->{tstats}->{waitingForPackets}) {
      print "not ";
    }
    print "waiting for packets.\n";
    if (exists $val->{tstats}->{nWaiting}) {
      print "$val->{tstats}->{nWaiting} calls waiting for a thread\n";
    }
    if (exists $val->{tstats}->{idleThreads}) {
      print "$val->{tstats}->{idleThreads} threads are idle\n";
    }
  }

  # print rxstats if they were returned
  if (exists $val->{rxstats}) {

    print "rx stats: free packets ", $val->{tstats}->{nFreePackets},
          ", allocs ", $val->{rxstats}->{packetRequests}, ", ";

    if ($val->{tstats}->{version} >=
               constant("RX_DEBUGI_VERSION_W_NEWPACKETTYPES")) {

      print "alloc-failures(rcv ", $val->{rxstats}->{receivePktAllocFailures},
        "/", $val->{rxstats}->{receiveCbufPktAllocFailures},
        ",send ", $val->{rxstats}->{sendPktAllocFailures},
        "/", $val->{rxstats}->{sendCbufPktAllocFailures},
        ",ack ", $val->{rxstats}->{specialPktAllocFailures}, ")\n";
    } else {
      print "alloc-failures(rcv ", $val->{rxstats}->{receivePktAllocFailures},
            ",send ", $val->{rxstats}->{sendPktAllocFailures},
            ",ack ", $val->{rxstats}->{specialPktAllocFailures}, ")\n";
    }

examples/rxdebug  view on Meta::CPAN

    print "   other read counters: data ", $val->{rxstats}->{dataPacketsRead},
          ", ack ", $val->{rxstats}->{ackPacketsRead},
          ", dup ", $val->{rxstats}->{dupPacketsRead},
          " spurious ", $val->{rxstats}->{spuriousPacketsRead},
          " dally ", $val->{rxstats}->{ignorePacketDally}, "\n";

    print "   packets sent: ";
    foreach my $key (sort keys %{$val->{rxstats}->{packets}}) {
      print $key, " ", $val->{rxstats}->{packets}->{$key}->{packetsSent}, " ";
    }
    print "\n";

    print "   other send counters: ack ", $val->{rxstats}->{ackPacketsSent},
          ", data ", $val->{rxstats}->{dataPacketsSent},
          " (not resends), resends ", $val->{rxstats}->{dataPacketsReSent},
          ", pushed ", $val->{rxstats}->{dataPacketsPushed},
          ", acked&ignored ", $val->{rxstats}->{ignoreAckedPacket}, "\n";
    print "   \t(these should be small) ",
          "sendFailed ", $val->{rxstats}->{netSendFailures},
          ", fatalErrors ", $val->{rxstats}->{fatalErrors}, "\n";

    if ($val->{rxstats}->{nRttSamples}) {
      my $avrtt = $val->{rxstats}->{totalRtt}->{usec} / 1000000.00;
         $avrtt = $avrtt + $val->{rxstats}->{totalRtt}->{sec};
         $avrtt = $avrtt / $val->{rxstats}->{nRttSamples};

      printf("   Average rtt is %0.3f, with %d samples\n",
                 $avrtt,
                 $val->{rxstats}->{nRttSamples});

      my $minrtt = $val->{rxstats}->{minRtt}->{usec} / 1000000.00;
         $minrtt = $minrtt + $val->{rxstats}->{minRtt}->{sec};
      my $maxrtt = $val->{rxstats}->{maxRtt}->{usec} / 1000000.00;
         $maxrtt = $maxrtt + $val->{rxstats}->{maxRtt}->{sec};
      printf("   Minimum rtt is %0.3f, maximum is %0.3f\n",
            $minrtt,
            $maxrtt);
    }

    print "   ", $val->{rxstats}->{nServerConns}, " server connections, ",
           $val->{rxstats}->{nClientConns}, " client connections, ",
           $val->{rxstats}->{nPeerStructs}, " peer structs, ",
           $val->{rxstats}->{nCallStructs}, " call structs, ",
           $val->{rxstats}->{nFreeCallStructs}, " free call structs\n";
    if (exists $val->{rxstats}->{clock_nUpdates}) {
      print "   ", $val->{rxstats}->{clock_nUpdates}, " clock updates\n";
    }
  }

  # print connections if they were returned
  if (exists $val->{connections}) {
    for (my $i = 0; $i <= $#{$val->{connections}}; $i++) { # print each connection
      print "Connection from host ", $val->{connections}->[$i]->{host},
            ", port ", $val->{connections}->[$i]->{port},", ";

      if ($val->{connections}->[$i]->{epoch}) {
        printf "Cuid %x/%x", $val->{connections}->[$i]->{epoch}, $val->{connections}->[$i]->{cid};
      } else {
        printf "cid %x", $val->{connections}->[$i]->{cid};
      }
      if ($val->{connections}->[$i]->{error}) {
        print ", error ", $val->{connections}->[$i]->{error};
      }
      print "\n  serial $val->{connections}->[$i]->{serial}, ";
      print " natMTU $val->{connections}->[$i]->{natMTU}, ";

      if ($val->{connections}->[$i]->{flags}) {
        print "flags";
        if ($val->{connections}->[$i]->{flags} & constant("RX_CONN_MAKECALL_WAITING")) {
          print " MAKECALL_WAITING";
        }
        if ($val->{connections}->[$i]->{flags} & constant("RX_CONN_DESTROY_ME")) {
          print " DESTROYED";
        }
        if ($val->{connections}->[$i]->{flags} & constant("RX_CONN_USING_PACKET_CKSUM")) {
          print " pktCksum";
        }
        print ", ";
      }

      print "security index $val->{connections}->[$i]->{securityIndex}, ";
      if ($val->{connections}->[$i]->{type} == constant("RX_CLIENT_CONNECTION")) {
        print "client conn\n";
      } else {
        print "server conn\n";
      }

      # print secStats if this connection has them
      if (exists $val->{connections}->[$i]->{secStats}) {
        my $secStatsType = $val->{connections}->[$i]->{secStats}->{type};
        if ($secStatsType == 0) {
          if ($val->{connections}->[$i]->{securityIndex} == 2) {
            print "  no GetStats procedure for security object\n";
          }
        } elsif ($secStatsType == 1) {
          print "  rxnull level=", $val->{connections}->[$i]->{secStats}->{level};
          print ", flags=", $val->{connections}->[$i]->{secStats}->{flags},"\n";
        } elsif ($secStatsType == 2) {
          print "  rxvab level=", $val->{connections}->[$i]->{secStats}->{level};
          print ", flags=", $val->{connections}->[$i]->{secStats}->{flags},"\n";
        } elsif ($secStatsType == 3) {
          my $secStatsLevel;
          my $secStatsFlags = $val->{connections}->[$i]->{secStats}->{flags};
          if ($val->{connections}->[$i]->{secStats}->{level} == 0) {
            $secStatsLevel = "clear";
          } elsif ($val->{connections}->[$i]->{secStats}->{level} == 1) {
            $secStatsLevel = "auth";
          } elsif ($val->{connections}->[$i]->{secStats}->{level} == 2) {
            $secStatsLevel = "crypt";
          } else {
            $secStatsLevel = "unknown";
          }
          print "  rxkad: level ", $secStatsLevel;
          if ($secStatsFlags) {
            print ", flags";
          }
          if ($secStatsFlags & 1) {
            print " unalloc";
          }
          if ($secStatsFlags & 2) {
            print " authenticated";
          }
          if ($secStatsFlags & 4) {
            print " expired";
          }
          if ($secStatsFlags & 8) {
            print " pktCksum";
          }
          if ($val->{connections}->[$i]->{secStats}->{expires}) {
            my $secStatsExpires = $val->{connections}->[$i]->{secStats}->{expires} - time();
            $secStatsExpires = $secStatsExpires / 3600.0;
            printf(", expires in %.1f hours", $secStatsExpires);
          }
          if (!($secStatsFlags & 1)) {
            print "\n  Received ", $val->{connections}->[$i]->{secStats}->{bytesReceived},
                  " bytes in ", $val->{connections}->[$i]->{secStats}->{packetsReceived}," packets\n";
            print "  Sent ", $val->{connections}->[$i]->{secStats}->{bytesSent},
                  " bytes in ", $val->{connections}->[$i]->{secStats}->{packetsSent}, " packets\n";
          } else {
            print "\n";
          }
        } else {
          print "  unknown\n";
        }
      } # done printing secStats

      # print calls for this connection
      for (my $j = 0; $j < constant("RX_MAXCALLS"); $j++) {
        print "    call ", $j, ": # ", $val->{connections}->[$i]->{callNumber}->[$j], ", state ";

        # print call state
        if ($val->{connections}->[$i]->{callState}->[$j] == constant("RX_STATE_NOTINIT")) {
          print "not initialized\n";
          next;
        } elsif ($val->{connections}->[$i]->{callState}->[$j] == constant("RX_STATE_PRECALL")) {
          print "precall, ";
        } elsif ($val->{connections}->[$i]->{callState}->[$j] == constant("RX_STATE_ACTIVE")) {
          print "active, ";
        } elsif ($val->{connections}->[$i]->{callState}->[$j] == constant("RX_STATE_DALLY")) {
          print "dally, ";
        } elsif ($val->{connections}->[$i]->{callState}->[$j] == constant("RX_STATE_HOLD")) {
          print "hold, ";
        }

        # print call mode
        print "mode: ";
        if ($val->{connections}->[$i]->{callMode}->[$j] == constant("RX_MODE_SENDING")) {
          print "sending";
        } elsif ($val->{connections}->[$i]->{callMode}->[$j] == constant("RX_MODE_RECEIVING")) {
          print "receiving";
        } elsif ($val->{connections}->[$i]->{callMode}->[$j] == constant("RX_MODE_ERROR")) {
          print "error";
        } elsif ($val->{connections}->[$i]->{callMode}->[$j] == constant("RX_MODE_EOF")) {
          print "eof";
        } else {
          print "unknown";
        }

        # print flags for this call
        if ($val->{connections}->[$i]->{callFlags}->[$j]) {
          printf(", flags:");
          if ($val->{connections}->[$i]->{callFlags}->[$j] & constant("RX_CALL_READER_WAIT")) {
            print " reader_wait";
          }
          if ($val->{connections}->[$i]->{callFlags}->[$j] & constant("RX_CALL_WAIT_WINDOW_ALLOC")) {
            print " window_alloc";
          }
          if ($val->{connections}->[$i]->{callFlags}->[$j] & constant("RX_CALL_WAIT_WINDOW_SEND")) {
            print " window_send";
          }
          if ($val->{connections}->[$i]->{callFlags}->[$j] & constant("RX_CALL_WAIT_PACKETS")) {
            print " wait_packets";
          }
          if ($val->{connections}->[$i]->{callFlags}->[$j] & constant("RX_CALL_WAIT_PROC")) {
            print " waiting_for_process";
          }
          if ($val->{connections}->[$i]->{callFlags}->[$j] & constant("RX_CALL_RECEIVE_DONE")) {
            print " receive_done";
          }
          if ($val->{connections}->[$i]->{callFlags}->[$j] & constant("RX_CALL_CLEARED")) {
            print " call_cleared";
          }
        }
        if ($val->{connections}->[$i]->{callOther}->[$j] & constant("RX_OTHER_IN")) {
          print ", has_input_packets";
        }
        if ($val->{connections}->[$i]->{callOther}->[$j] & constant("RX_OTHER_OUT")) {
          print ", has_output_packets";
        }
        print "\n";
      }
    }
    # if -nodally flag was set, print number of dallying connections skipped
    if (exists $val->{dallyCounter}) {
      print "Skipped ", $val->{dallyCounter}, " dallying connections.\n";
    }
  } # done printing connections

  # print peers if they were returned
  if (exists $val->{peers}) {
    for (my $i = 0; $i <= $#{$val->{peers}}; $i++) {
      print "Peer at host ", $val->{peers}->[$i]->{host},
            ", port ", $val->{peers}->[$i]->{port}, "\n";

      printf("\tifMTU %hu\tnatMTU %hu\tmaxMTU %hu\n",
              $val->{peers}->[$i]->{ifMTU},
              $val->{peers}->[$i]->{natMTU},
              $val->{peers}->[$i]->{maxMTU});
      printf("\tpackets sent %d\tpacket resends %d\n",
              $val->{peers}->[$i]->{nSent},
              $val->{peers}->[$i]->{reSends});
      printf("\tbytes sent high %d low %d\n",