~ubuntu-branches/ubuntu/trusty/libnetpacket-perl/trusty

« back to all changes in this revision

Viewing changes to lib/NetPacket/USBMon.pm

  • Committer: Package Import Robot
  • Author(s): Florian Schlichting
  • Date: 2013-12-04 23:49:19 UTC
  • mfrom: (1.1.10)
  • Revision ID: package-import@ubuntu.com-20131204234919-5ebhy77qln1p1fis
Tags: 1.4.4-1
* Import Upstream version 1.4.4
* Drop spelling.patch, whatis.patch: both applied upstream

Show diffs side-by-side

added added

removed removed

Lines of Context:
3
3
  $NetPacket::USBMon::AUTHORITY = 'cpan:YANICK';
4
4
}
5
5
{
6
 
  $NetPacket::USBMon::VERSION = '1.4.2';
 
6
  $NetPacket::USBMon::VERSION = '1.4.4';
7
7
}
 
8
#ABSTRACT: Assemble and disassemble USB packets captured via Linux USBMon interface.
 
9
 
 
10
use 5.10.0;
8
11
 
9
12
use strict;
10
13
use vars qw(@ISA @EXPORT_OK %EXPORT_TAGS);
65
68
    my($id, $type, $xfer_type, $epnum, $devnum, $busnum, $flag_setup,
66
69
        $flag_data, $ts_sec, $ts_usec, $status, $length, $len_cap,
67
70
        $s, $interval, $start_frame, $xfer_flags, $ndesc, $rest) =
68
 
        unpack('a8CCCCSCCa8liIIa8llLLa*', $packet);
 
71
        unpack('a8CCCCS<CCa8l<i<I<I<a8l<l<L<L<a*', $packet);
69
72
 
70
 
    # Try to grok quads. We may loose some address information with 32-bit
 
73
    # Try to grok quads. We may lose some address information with 32-bit
71
74
    # Perl parsing 64-bit captures, or timestamp after 2038. Still the best
72
75
    # we can do.
73
76
    eval {
74
 
      $id = unpack ('Q', $id);
75
 
      $ts_sec = unpack ('Q', $ts_sec);
 
77
      $id = unpack ('Q<', $id);
 
78
      $ts_sec = unpack ('Q<', $ts_sec);
76
79
    };
77
80
    if ($@) {
78
 
      ($id) = unpack ('LL', $id);
79
 
      ($ts_sec) = unpack ('LL', $ts_sec);
 
81
      ($id) = unpack ('L<L<', $id);
 
82
      ($ts_sec) = unpack ('L<L<', $ts_sec);
80
83
    }
81
84
 
82
85
    my $self = {
115
118
 
116
119
        if ($setup->{bmRequestType} & USB_TYPE_VENDOR) {
117
120
           ($setup->{wValue}, $setup->{wIndex},
118
 
                $setup->{wLength}) = unpack('S3', $rest);
 
121
                $setup->{wLength}) = unpack('S<3', $rest);
119
122
        } else {
120
123
            # Unknown setup request;
121
124
            $setup->{data} = $rest;
127
130
    # Isochronous descriptors
128
131
    if ($self->{xfer_type} == USB_XFER_TYPE_ISO) {
129
132
        my $iso = {};
130
 
       ($iso->{error_count}, $iso->{numdesc}) = unpack('ii', $s);
 
133
       ($iso->{error_count}, $iso->{numdesc}) = unpack('i<i<', $s);
131
134
        $self->{iso} = $iso;
132
135
    }
133
136
 
151
154
 
152
155
=head1 VERSION
153
156
 
154
 
version 1.4.2
 
157
version 1.4.4
155
158
 
156
159
=head1 SYNOPSIS
157
160