diff options
Diffstat (limited to 'xpp/zconf/Zaptel')
-rw-r--r-- | xpp/zconf/Zaptel/Chans.pm | 202 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Config/Defaults.pm | 56 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Hardware.pm | 168 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Hardware/PCI.pm | 208 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Hardware/USB.pm | 116 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Span.pm | 300 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Utils.pm | 52 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Xpp.pm | 199 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Xpp/Line.pm | 95 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Xpp/Xbus.pm | 118 | ||||
-rw-r--r-- | xpp/zconf/Zaptel/Xpp/Xpd.pm | 123 |
11 files changed, 1637 insertions, 0 deletions
diff --git a/xpp/zconf/Zaptel/Chans.pm b/xpp/zconf/Zaptel/Chans.pm new file mode 100644 index 0000000..6f83f77 --- /dev/null +++ b/xpp/zconf/Zaptel/Chans.pm @@ -0,0 +1,202 @@ +package Zaptel::Chans; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Utils; + +=head1 NAME + +Zaptel::Chans - Perl interface to a Zaptel channel information + +This package allows access from perl to information about a Zaptel +channel. It is part of the Zaptel Perl package. + +=head1 battery() + +Returns 1 if channel reports to have battery (A remote PBX connected to +an FXO port), 0 if channel reports to not have battery and C<undef> +otherwise. + +Currently only wcfxo and Astribank FXO modules report battery. For the +rest of the channels + +=head1 fqn() + +(Fully Qualified Name) Returns the full "name" of the channel. + +=head1 index() + +Returns the number of this channel (in the span). + +=head1 num() + +Returns the number of this channel as a Zaptel channel. + +=head signalling() + +Returns the signalling set for this channel through /etc/zaptel.conf . +This is always empty before ztcfg was run. And shows the "other" type +for FXS and for FXO. + +=head1 span() + +Returns a reference to the span to which this channel belongs. + +=head1 type() + +Returns the type of the channel: 'FXS', 'FXO', 'EMPTY', etc. + +=cut + +sub new($$$$$$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $span = shift or die "Missing a span parameter\n"; + my $index = shift; + my $line = shift or die "Missing an input line\n"; + defined $index or die "Missing an index parameter\n"; + my $self = { + 'SPAN' => $span, + 'INDEX' => $index, + }; + bless $self, $pack; + my ($num, $fqn, $rest) = split(/\s+/, $line, 3); + $num or die "Missing a channel number parameter\n"; + $fqn or die "Missing a channel fqn parameter\n"; + my $signalling = ''; + my $info = ''; + if(defined $rest) { + if($rest =~ s/^\s*(\w+)\s*//) { + $signalling = $1; + } + if($rest =~ s/(.*)//) { + $info = $1; + } + } + $self->{NUM} = $num; + $self->{FQN} = $fqn; + $self->{SIGNALLING} = $signalling; + $self->{INFO} = $info; + my $type; + if($fqn =~ m|\bXPP_(\w+)/.*$|) { + $type = $1; # An Astribank + } elsif ($fqn =~ m{\bWCFXO/.*}) { + $type = "FXO"; # wcfxo - x100p and relatives. + # A single port card. The driver issue RED alarm when + # There's no better + $self->{BATTERY} = !($span->description =~ /\bRED\b/); + } elsif ($fqn =~ m{\bFXS/.*}) { + $type = "FXS"; # likely Rhino + } elsif ($fqn =~ m{\bFXO/.*}) { + $type = "FXO"; # likely Rhino + } elsif ($fqn =~ m{\b---/.*}) { + $type = "EMPTY"; # likely Rhino, empty slot. + } elsif ($fqn =~ m{\b(TE[24]|WCT1|Tor2|TorISA|WP[TE]1|cwain[12])/.*}) { + # TE[24]: Digium wct4xxp + # WCT1: Digium single span card drivers? + # Tor2: Tor PCI cards + # TorISA: ISA ones (still used?) + # WP[TE]1: Sangoma. TODO: this one tells us if it is TE or NT. + # cwain: Junghanns E1 card. + $type = "PRI"; + } elsif ($fqn =~ m{\b(ZTHFC%d*|ztqoz\d*)/.*}) { + # ZTHFC: HFC-s single-port card (zaphfc/vzaphfc) + # ztqoz: qozap (Junghanns) multi-port HFC card + $type = "BRI"; + } elsif ($fqn =~ m{\bztgsm/.*}) { + # Junghanns GSM card + $type = "GSM"; + } elsif(defined $signalling) { + $type = 'FXS' if $signalling =~ /^FXS/; + $type = 'FXO' if $signalling =~ /^FXO/; + } else { + $type = undef; + } + $self->type($type); + $self->span()->type($type) + if ! defined($self->span()->type()) || + $self->span()->type() eq 'UNKNOWN'; + return $self; +} + +=head1 probe_type() + +In the case of some cards, the information in /proc/zaptel is not good +enough to tell the type of each channel. In this case an extra explicit +probe is needed. + +Currently this is implemented by using some invocations of ztcfg(8). + +It may later be replaced by ztscan(8). + +=cut + +my $ztcfg = $ENV{ZTCFG} || '/sbin/ztcfg'; +sub probe_type($) { + my $self = shift; + my $fqn = $self->fqn; + my $num = $self->num; + my $type; + + if($fqn =~ m:WCTDM/| WRTDM/|OPVXA1200/:) { + my %maybe; + + undef %maybe; + foreach my $sig (qw(fxo fxs)) { + my $cmd = "echo ${sig}ks=$num | $ztcfg -c /dev/fd/0"; + + $maybe{$sig} = system("$cmd >/dev/null 2>&1") == 0; + } + if($maybe{fxo} and $maybe{fxs}) { + $type = 'EMPTY'; + } elsif($maybe{fxo}) { + $type = 'FXS'; + } elsif($maybe{fxs}) { + $type = 'FXO'; + } else { + $type = 'EMPTY'; + } + } else { + $type = $self->type; + } + return $type; +} + +sub battery($) { + my $self = shift or die; + my $span = $self->span or die; + + return undef unless $self->type eq 'FXO'; + return $self->{BATTERY} if defined $self->{BATTERY}; + + my $xpd = $span->xpd; + my $index = $self->index; + return undef if !$xpd; + + # It's an XPD (FXO) + my @lines = @{$xpd->lines}; + my $line = $lines[$index]; + return $line->battery; +} + +sub blink($$) { + my $self = shift or die; + my $on = shift; + my $span = $self->span or die; + + my $xpd = $span->xpd; + my $index = $self->index; + return undef if !$xpd; + + my @lines = @{$xpd->lines}; + my $line = $lines[$index]; + return $line->blink($on); +} + + +1; diff --git a/xpp/zconf/Zaptel/Config/Defaults.pm b/xpp/zconf/Zaptel/Config/Defaults.pm new file mode 100644 index 0000000..360ca0a --- /dev/null +++ b/xpp/zconf/Zaptel/Config/Defaults.pm @@ -0,0 +1,56 @@ +package Zaptel::Config::Defaults; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; + +# Use the shell to source a file and expand a given list +# of variables. +sub do_source($@) { + my $file = shift; + my @vars = @_; + my @output = `env -i sh -ec '. $file; export @vars; for i in @vars; do eval echo \$i=\\\$\$i; done'`; + die "$0: Sourcing '$file' exited with $?" if $?; + my %vars; + + foreach my $line (@output) { + chomp $line; + my ($k, $v) = split(/=/, $line, 2); + $vars{$k} = $v if grep /^$k$/, @vars; + } + return %vars; +} + +sub source_vars { + my @vars = @_; + my $default_file; + my %system_files = ( + "/etc/default/zaptel" => 'Debian and friends', + "/etc/sysconfig/zaptel" => 'Red Hat and friends', + ); + + if(defined $ENV{ZAPTEL_DEFAULTS}) { + $default_file = $ENV{ZAPTEL_DEFAULTS}; + } else { + foreach my $f (keys %system_files) { + if(-r $f) { + if(defined $default_file) { + die "An '$f' collides with '$default_file'"; + } + $default_file = $f; + } + } + } + if (! $default_file) { + return ("", ()); + } + my %vars = Zaptel::Config::Defaults::do_source($default_file, @vars); + return ($default_file, %vars); +} + +1; diff --git a/xpp/zconf/Zaptel/Hardware.pm b/xpp/zconf/Zaptel/Hardware.pm new file mode 100644 index 0000000..ff7aeea --- /dev/null +++ b/xpp/zconf/Zaptel/Hardware.pm @@ -0,0 +1,168 @@ +package Zaptel::Hardware; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Hardware::USB; +use Zaptel::Hardware::PCI; + +=head1 NAME + +Zaptel::Hardware - Perl interface to a Zaptel devices listing + + + use Zaptel::Hardware; + + my $hardware = Zaptel::Hardware->scan; + + # mini zaptel_hardware: + foreach my $device ($hardware->device_list) { + print "Vendor: device->{VENDOR}, Product: $device->{PRODUCT}\n" + } + + # let's see if there are devices without loaded drivers, and sugggest + # drivers to load: + my @to_load = (); + foreach my $device ($hardware->device_list) { + if (! $device->{LOADED} ) { + push @to_load, ($device->${DRIVER}); + } + } + if (@to_load) { + print "To support the extra devices you probably need to run:\n" + print " modprobe ". (join ' ', @to_load). "\n"; + } + + +This module provides information about available Zaptel devices on the +system. It identifies devices by (USB/PCI) bus IDs. + + +=head1 Device Attributes +As usual, object attributes can be used in either upp-case or +lower-case, or lower-case functions. + +=head2 bus_type + +'PCI' or 'USB'. + + +=head2 description + +A one-line description of the device. + + +=head2 driver + +Name of a Zaptel device driver that should handle this device. This is +based on a pre-made list. + + +=head2 vendor, product, subvendor, subproduct + +The PCI and USB vendor ID, product ID, sub-vendor ID and sub-product ID. +(The standard short lspci and lsusb listings show only vendor and +product IDs). + + +=head2 loaded + +If the device is handled by a module - the name of the module. Else - +undef. + + +=head2 priv_device_name + +A string that shows the "location" of that device on the bus. + + +=head2 is_astribank + +True if the device is a Xorcom Astribank (which may provide some extra +attributes). + +=head2 serial + +(Astribank-specific attrribute) - the serial number string of the +Astribank. + +=cut + +sub device_detected($$) { + my $dev = shift || die; + my $name = shift || die; + die unless defined $dev->{'BUS_TYPE'}; + $dev->{IS_ASTRIBANK} = 0 unless defined $dev->{'IS_ASTRIBANK'}; + $dev->{'HARDWARE_NAME'} = $name; +} + +sub device_removed($) { + my $dev = shift || die; + my $name = $dev->hardware_name; + die "Missing zaptel device hardware name" unless $name; +} + + +=head1 device_list() + +Returns a list of the hardware devices on the system. + +You must run scan() first for this function to run meaningful output. + +=cut + +sub device_list($) { + my $self = shift || die; + my @types = @_; + my @list; + + @types = qw(USB PCI) unless @types; + foreach my $t (@types) { + @list = ( @list, @{$self->{$t}} ); + } + return @list; +} + + +=head1 drivers() + +Returns a list of drivers (currently sorted by name) that are used by +the devices in the current system (regardless to whether or not they are +loaded. + +=cut + +sub drivers($) { + my $self = shift || die; + my @devs = $self->device_list; + my @drvs = map { $_->{DRIVER} } @devs; + # Make unique + my %drivers; + @drivers{@drvs} = 1; + return sort keys %drivers; +} + + +=head1 scan() + +Scan the system for Zaptel devices (PCI and USB). Returns nothing but +must be run to initialize the module. + +=cut + +sub scan($) { + my $pack = shift || die; + my $self = {}; + bless $self, $pack; + + $self->{USB} = [ Zaptel::Hardware::USB->devices ]; + $self->{PCI} = [ Zaptel::Hardware::PCI->scan_devices ]; + return $self; +} + +1; diff --git a/xpp/zconf/Zaptel/Hardware/PCI.pm b/xpp/zconf/Zaptel/Hardware/PCI.pm new file mode 100644 index 0000000..a63b09f --- /dev/null +++ b/xpp/zconf/Zaptel/Hardware/PCI.pm @@ -0,0 +1,208 @@ +package Zaptel::Hardware::PCI; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Utils; +use Zaptel::Hardware; + +our @ISA = qw(Zaptel::Hardware); + +# Lookup algorithm: +# First match 'vendor:product/subvendor:subproduct' key +# Else match 'vendor:product/subvendor' key +# Else match 'vendor:product' key +# Else not a zaptel hardware. +my %pci_ids = ( + # from wct4xxp + '10ee:0314' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P/TE405P (1st Gen)' }, + 'd161:0420/0004' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE420 (4th Gen)' }, + 'd161:0410/0004' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P (4th Gen)' }, + 'd161:0405/0004' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE405P (4th Gen)' }, + 'd161:0410/0003' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P (3rd Gen)' }, + 'd161:0405/0003' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE405P (3rd Gen)' }, + 'd161:0410' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE410P (2nd Gen)' }, + 'd161:0405' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE405P (2nd Gen)' }, + 'd161:0220/0004' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE220 (4th Gen)' }, + 'd161:0205/0004' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE205P (4th Gen)' }, + 'd161:0210/0004' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE210P (4th Gen)' }, + 'd161:0205/0003' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE205P (3rd Gen)' }, + 'd161:0210/0003' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE210P (3rd Gen)' }, + 'd161:0205' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE205P ' }, + 'd161:0210' => { DRIVER => 'wct4xxp', DESCRIPTION => 'Wildcard TE210P ' }, + + # from wctdm24xxp + 'd161:2400' => { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard TDM2400P' }, + 'd161:0800' => { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard TDM800P' }, + 'd161:8002' => { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard AEX800' }, + 'd161:8003' => { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard AEX2400' }, + 'd161:8005' => { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard TDM410P' }, + 'd161:8006' => { DRIVER => 'wctdm24xxp', DESCRIPTION => 'Wildcard AEX410P' }, + + # from pciradio + 'e159:0001/e16b' => { DRIVER => 'pciradio', DESCRIPTION => 'PCIRADIO' }, + + # from wcfxo + 'e159:0001/8084' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P clone' }, + 'e159:0001/8085' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P' }, + 'e159:0001/8086' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P clone' }, + 'e159:0001/8087' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X101P clone' }, + '1057:5608' => { DRIVER => 'wcfxo', DESCRIPTION => 'Wildcard X100P' }, + + # from wct1xxp + 'e159:0001/6159' => { DRIVER => 'wct1xxp', DESCRIPTION => 'Digium Wildcard T100P T1/PRI or E100P E1/PRA Board' }, + + # from wctdm + 'e159:0001/a159' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard S400P Prototype' }, + 'e159:0001/e159' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard S400P Prototype' }, + 'e159:0001/b100' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV E/F' }, + 'e159:0001/b1d9' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV I' }, + 'e159:0001/b118' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV I' }, + 'e159:0001/b119' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV I' }, + 'e159:0001/a9fd' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' }, + 'e159:0001/a8fd' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' }, + 'e159:0001/a800' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' }, + 'e159:0001/a801' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' }, + 'e159:0001/a908' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' }, + 'e159:0001/a901' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' }, + #'e159:0001' => { DRIVER => 'wctdm', DESCRIPTION => 'Wildcard TDM400P REV H' }, + + # from wcte11xp + 'e159:0001/71fe' => { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' }, + 'e159:0001/79fe' => { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' }, + 'e159:0001/795e' => { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' }, + 'e159:0001/79de' => { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' }, + 'e159:0001/797e' => { DRIVER => 'wcte11xp', DESCRIPTION => 'Digium Wildcard TE110P T1/E1 Board' }, + + # from wcte12xp + 'd161:0120' => { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE12xP' }, + 'd161:8000' => { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE121' }, + 'd161:8001' => { DRIVER => 'wcte12xp', DESCRIPTION => 'Wildcard TE122' }, + + # from tor2 + '10b5:9030' => { DRIVER => 'tor2', DESCRIPTION => 'PLX 9030' }, + '10b5:3001' => { DRIVER => 'tor2', DESCRIPTION => 'PLX Development Board' }, + '10b5:D00D' => { DRIVER => 'tor2', DESCRIPTION => 'Tormenta 2 Quad T1/PRI or E1/PRA' }, + '10b5:4000' => { DRIVER => 'tor2', DESCRIPTION => 'Tormenta 2 Quad T1/E1 (non-Digium clone)' }, + + # Cologne Chips: + # (Still a partial list) + '1397:08b4/b556' => { DRIVER => 'qozap', DESCRIPTION => 'Junghanns DuoBRI ISDN card' }, + '1397:08b4' => { DRIVER => 'qozap', DESCRIPTION => 'Junghanns QuadBRI ISDN card' }, + '1397:16b8' => { DRIVER => 'qozap', DESCRIPTION => 'Junghanns OctoBRI ISDN card' }, + '1397:30b1' => { DRIVER => 'cwain', DESCRIPTION => 'HFC-E1 ISDN E1 card' }, + '1397:2bd0' => { DRIVER => 'zaphfc', DESCRIPTION => 'HFC-S ISDN BRI card' }, + '1397:f001' => { DRIVER => 'ztgsm', DESCRIPTION => 'HFC-GSM Cologne Chips GSM' }, + + # Rhino cards (based on pci.ids) + '0b0b:0105' => { DRIVER => 'r1t1', DESCRIPTION => 'Rhino R1T1' }, + '0b0b:0205' => { DRIVER => 'r4fxo', DESCRIPTION => 'Rhino R14FXO' }, + '0b0b:0206' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB4FXO 4-channel FXO analog telphony card' }, + '0b0b:0305' => { DRIVER => 'r1t1', DESCRIPTION => 'Rhino R1T1' }, + '0b0b:0405' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino R8FXX' }, + '0b0b:0406' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB8FXX 8-channel modular analog telphony card' }, + '0b0b:0505' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino R24FXX' }, + '0b0b:0506' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB24FXS 24-Channel FXS analog telphony card' }, + '0b0b:0605' => { DRIVER => 'rxt1', DESCRIPTION => 'Rhino R2T1' }, + '0b0b:0705' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino R24FXS' }, + '0b0b:0706' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB24FXO 24-Channel FXO analog telphony card' }, + '0b0b:0906' => { DRIVER => 'rcbfx', DESCRIPTION => 'Rhino RCB24FXX 24-channel modular analog telphony card' }, + + # Sangoma cards (based on pci.ids) + '1923:0040' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A200/Remora FXO/FXS Analog AFT card' }, + '1923:0100' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A104d QUAD T1/E1 AFT card' }, + '1923:0300' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A101 single-port T1/E1' }, + '1923:0400' => { DRIVER => 'wanpipe', DESCRIPTION => 'Sangoma Technologies Corp. A104u Quad T1/E1 AFT' }, + ); + +$ENV{PATH} .= ":/usr/sbin:/sbin:/usr/bin:/bin"; + +sub pci_sorter { + return $a->priv_device_name() cmp $b->priv_device_name(); +} + +sub new($$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $self = { @_ }; + bless $self, $pack; + Zaptel::Hardware::device_detected($self, + sprintf("pci:%s", $self->{PRIV_DEVICE_NAME})); + return $self; +} + +my %pci_devs; + +sub readfile($) { + my $name = shift || die; + open(F, $name) || die "Failed to open '$name': $!"; + my $str = <F>; + close F; + chomp($str); + return $str; +} + +sub scan_devices($) { + my @devices; + + while(</sys/bus/pci/devices/*>) { + m,([^/]+)$,,; + my $name = $1; + my $l = readlink $_ || die; + $pci_devs{$name}{PRIV_DEVICE_NAME} = $name; + $pci_devs{$name}{DEVICE} = $l; + $pci_devs{$name}{VENDOR} = readfile "$_/vendor"; + $pci_devs{$name}{PRODUCT} = readfile "$_/device"; + $pci_devs{$name}{SUBVENDOR} = readfile "$_/subsystem_vendor"; + $pci_devs{$name}{SUBPRODUCT} = readfile "$_/subsystem_device"; + my $dev = $pci_devs{$name}; + grep(s/0x//, $dev->{VENDOR}, $dev->{PRODUCT}, $dev->{SUBVENDOR}, $dev->{SUBPRODUCT}); + $pci_devs{$name}{DRIVER} = ''; + } + + while(</sys/bus/pci/drivers/*/[0-9]*>) { + m,^(.*?)/([^/]+)/([^/]+)$,; + my $prefix = $1; + my $drvname = $2; + my $id = $3; + my $l = readlink "$prefix/$drvname/module"; + # Find the real module name (if we can). + if(defined $l) { + my $moduledir = "$prefix/$drvname/$l"; + my $modname = $moduledir; + $modname =~ s:^.*/::; + $drvname = $modname; + } + $pci_devs{$id}{LOADED} = $drvname; + } + foreach (sort keys %pci_devs) { + my $dev = $pci_devs{$_}; + my $key; + # Try to match + $key = "$dev->{VENDOR}:$dev->{PRODUCT}/$dev->{SUBVENDOR}:$dev->{SUBPRODUCT}"; + $key = "$dev->{VENDOR}:$dev->{PRODUCT}/$dev->{SUBVENDOR}" if !defined($pci_ids{$key}); + $key = "$dev->{VENDOR}:$dev->{PRODUCT}" if !defined($pci_ids{$key}); + next unless defined $pci_ids{$key}; + + my $d = Zaptel::Hardware::PCI->new( + BUS_TYPE => 'PCI', + PRIV_DEVICE_NAME => $dev->{PRIV_DEVICE_NAME}, + VENDOR => $dev->{VENDOR}, + PRODUCT => $dev->{PRODUCT}, + SUBVENDOR => $dev->{SUBVENDOR}, + SUBPRODUCT => $dev->{SUBPRODUCT}, + LOADED => $dev->{LOADED}, + DRIVER => $pci_ids{$key}{DRIVER}, + DESCRIPTION => $pci_ids{$key}{DESCRIPTION}, + ); + push(@devices, $d); + } + @devices = sort pci_sorter @devices; + return @devices; +} + +1; diff --git a/xpp/zconf/Zaptel/Hardware/USB.pm b/xpp/zconf/Zaptel/Hardware/USB.pm new file mode 100644 index 0000000..a2dc08f --- /dev/null +++ b/xpp/zconf/Zaptel/Hardware/USB.pm @@ -0,0 +1,116 @@ +package Zaptel::Hardware::USB; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Utils; +use Zaptel::Hardware; +use Zaptel::Xpp; +use Zaptel::Xpp::Xbus; + +our @ISA = qw(Zaptel::Hardware); + +my %usb_ids = ( + # from wcusb + '06e6:831c' => { DRIVER => 'wcusb', DESCRIPTION => 'Wildcard S100U USB FXS Interface' }, + '06e6:831e' => { DRIVER => 'wcusb2', DESCRIPTION => 'Wildcard S110U USB FXS Interface' }, + '06e6:b210' => { DRIVER => 'wc_usb_phone', DESCRIPTION => 'Wildcard Phone Test driver' }, + + # from xpp_usb + 'e4e4:1130' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-8/16 no-firmware' }, + 'e4e4:1131' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-8/16 USB-firmware' }, + 'e4e4:1132' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-8/16 FPGA-firmware' }, + 'e4e4:1140' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-BRI no-firmware' }, + 'e4e4:1141' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-BRI USB-firmware' }, + 'e4e4:1142' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-BRI FPGA-firmware' }, + 'e4e4:1150' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-multi no-firmware' }, + 'e4e4:1151' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-multi USB-firmware' }, + 'e4e4:1152' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-multi FPGA-firmware' }, + 'e4e4:1160' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-modular no-firmware' }, + 'e4e4:1161' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-modular USB-firmware' }, + 'e4e4:1162' => { DRIVER => 'xpp_usb', DESCRIPTION => 'Astribank-modular FPGA-firmware' }, + ); + + +$ENV{PATH} .= ":/usr/sbin:/sbin:/usr/bin:/bin"; + +my @xbuses = Zaptel::Xpp::xbuses('SORT_CONNECTOR'); + +sub usb_sorter() { + return $a->hardware_name cmp $b->hardware_name; +} + +sub xbus_of_usb($) { + my $priv_device_name = shift; + my $dev = shift; + + my ($wanted) = grep { + defined($_->usb_devname) && + $priv_device_name eq $_->usb_devname + } @xbuses; + return $wanted; +} + +sub new($$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $self = { @_ }; + bless $self, $pack; + my $xbus = xbus_of_usb($self->priv_device_name); + if(defined $xbus) { + $self->{XBUS} = $xbus; + $self->{LOADED} = 'xpp_usb'; + } else { + $self->{XBUS} = undef; + $self->{LOADED} = undef; + } + Zaptel::Hardware::device_detected($self, + sprintf("usb:%s", $self->{PRIV_DEVICE_NAME})); + return $self; +} + +sub devices($) { + my $pack = shift || die; + my $usb_device_list = "/proc/bus/usb/devices"; + return unless (-r $usb_device_list); + + my @devices; + open(F, $usb_device_list) || die "Failed to open $usb_device_list: $!"; + local $/ = ''; + while(<F>) { + my @lines = split(/\n/); + my ($tline) = grep(/^T/, @lines); + my ($pline) = grep(/^P/, @lines); + my ($sline) = grep(/^S:.*SerialNumber=/, @lines); + my ($busnum,$devnum) = ($tline =~ /Bus=(\w+)\W.*Dev#=\s*(\w+)\W/); + my $devname = sprintf("%03d/%03d", $busnum, $devnum); + my ($vendor,$product) = ($pline =~ /Vendor=(\w+)\W.*ProdID=(\w+)\W/); + my $serial; + if(defined $sline) { + $sline =~ /SerialNumber=(.*)/; + $serial = $1; + #$serial =~ s/[[:^print:]]/_/g; + } + my $model = $usb_ids{"$vendor:$product"}; + next unless defined $model; + my $d = Zaptel::Hardware::USB->new( + IS_ASTRIBANK => ($model->{DRIVER} eq 'xpp_usb')?1:0, + BUS_TYPE => 'USB', + PRIV_DEVICE_NAME => $devname, + VENDOR => $vendor, + PRODUCT => $product, + SERIAL => $serial, + DESCRIPTION => $model->{DESCRIPTION}, + DRIVER => $model->{DRIVER}, + ); + push(@devices, $d); + } + close F; + @devices = sort usb_sorter @devices; +} + +1; diff --git a/xpp/zconf/Zaptel/Span.pm b/xpp/zconf/Zaptel/Span.pm new file mode 100644 index 0000000..be49c28 --- /dev/null +++ b/xpp/zconf/Zaptel/Span.pm @@ -0,0 +1,300 @@ +package Zaptel::Span; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Utils; +use Zaptel::Chans; +use Zaptel::Xpp::Xpd; + +=head1 NAME + +Zaptel::Spans - Perl interface to a Zaptel span information + +This package allows access from perl to information about a Zaptel +channel. It is part of the Zaptel Perl package. + +A span is a logical unit of Zaptel channels. Normally a port in a +digital card or a whole analog card. + +See documentation of module L<Zaptel> for usage example. Specifically +C<Zaptel::spans()> must be run initially. + +=head1 by_number() + +Get a span by its Zaptel span number. + +=head1 Span Properties + +=head2 num() + +The span number. + +=head2 name() + +The name field of a Zaptel span. E.g.: + + TE2/0/1 + +=head2 description() + +The description field of the span. e.g: + + "T2XXP (PCI) Card 0 Span 1" HDB3/CCS/CRC4 RED + +=head2 chans() + +The list of the channels (L<Zaptel::Chan> objects) of this span. +In a scalar context returns the number of channels this span has. + +=head2 bchans() + +Likewise a list of bchannels (or a count in a scalar context). + +=head2 is_sync_master() + +Is this span the source of timing for Zaptel? + +=head2 type() + +Type of span, or "UNKNOWN" if could not be detected. Current known +types: + +BRI_TE, BRI_NT, E1_TE, E1_NT, J1_TE, J1_NT, T1_TE, T1_NT, FXS, FXO + +=head2 is_pri() + +Is this an E1/J1/T1 span? + +=head2 is_bri() + +Is this a BRI span? + +=head2 is_digital() + +Is this a digital (as opposed to analog) span? + +=head2 termtype() + +Set for digital spans. "TE" or "NT". Will probably be assumed to be "TE" +if there's no information pointing either way. + +=head2 coding() + +Suggested sane coding type (e.g.: "hdb3", "b8zs") for this type of span. + +=head2 framing() + +Suggested sane framing type (e.g.: "ccs", "esf") for this type of span. + +=head2 yellow(), crc4() + +Likewise, suggestions ofr the respective fields in the span= line in +zaptel.conf for this span. + +=head2 signalling() + +Suggested zapata.conf signalling for channels of this span. + +=head2 switchtype() + +Suggested zapata.conf switchtype for channels of this span. + +=head1 Note + +Most of those properties are normally used as lower-case functions, but +actually set in the module as capital-letter propeties. To look at e.g. +"signalling" is set, look for "SIGNALLING". + +=cut + +my $proc_base = "/proc/zaptel"; + +sub chans($) { + my $span = shift; + return @{$span->{CHANS}}; +} + +sub by_number($) { + my $span_number = shift; + die "Missing span number" unless defined $span_number; + my @spans = Zaptel::spans(); + + my ($span) = grep { $_->num == $span_number } @spans; + return $span; +} + +my @bri_strings = ( + 'BRI_(NT|TE)', + '(?:quad|octo)BRI PCI ISDN Card.* \[(NT|TE)\]\ ', + 'octoBRI \[(NT|TE)\] ', + 'HFC-S PCI A ISDN.* \[(NT|TE)\] ' + ); + +my @pri_strings = ( + '(E1|T1|J1)_(NT|TE)', + 'Tormenta 2 .*Quad (E1|T1)', # tor2. + 'Digium Wildcard .100P (T1|E1)/', # wct1xxp + 'ISA Tormenta Span 1', # torisa + 'TE110P T1/E1', # wcte11xp + 'Wildcard TE120P', # wcte12xp + 'Wildcard TE121', # wcte12xp + 'Wildcard TE122', # wcte12xp + 'T[24]XXP \(PCI\) Card ', # wct4xxp + ); + +our $ZAPBRI_NET = 'bri_net'; +our $ZAPBRI_CPE = 'bri_cpe'; + +our $ZAPPRI_NET = 'pri_net'; +our $ZAPPRI_CPE = 'pri_cpe'; + +sub init_proto($$) { + my $self = shift; + my $proto = shift; + + $self->{PROTO} = $proto; + if($proto eq 'E1') { + $self->{DCHAN_IDX} = 15; + $self->{BCHAN_LIST} = [ 0 .. 14, 16 .. 30 ]; + } elsif($proto eq 'T1') { + $self->{DCHAN_IDX} = 23; + $self->{BCHAN_LIST} = [ 0 .. 22 ]; + } + $self->{TYPE} = "${proto}_$self->{TERMTYPE}"; +} + +sub new($$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $num = shift or die "Missing a span number parameter\n"; + my $self = { NUM => $num }; + bless $self, $pack; + $self->{TYPE} = "UNKNOWN"; + my @xpds = Zaptel::Xpp::Xpd::xpds_by_spanno; + my $xpd = $xpds[$num]; + if(defined $xpd) { + die "Spanno mismatch: $xpd->spanno, $num" unless $xpd->spanno == $num; + $self->{XPD} = $xpd; + } + open(F, "$proc_base/$num") or die "Failed to open '$proc_base/$num\n"; + my $head = <F>; + chomp $head; + $self->{IS_DIGITAL} = 0; + $self->{IS_BRI} = 0; + $self->{IS_PRI} = 0; + foreach my $cardtype (@bri_strings) { + if($head =~ m/$cardtype/) { + $self->{IS_DIGITAL} = 1; + $self->{IS_BRI} = 1; + $self->{TERMTYPE} = $1; + $self->{TYPE} = "BRI_$1"; + $self->{DCHAN_IDX} = 2; + $self->{BCHAN_LIST} = [ 0, 1 ]; + last; + } + } + foreach my $cardtype (@pri_strings) { + if($head =~ m/$cardtype/) { + my @info; + + push(@info, $1) if defined $1; + push(@info, $2) if defined $2; + my ($proto) = grep(/(E1|T1|J1)/, @info); + $proto = 'UNKNOWN' unless defined $proto; + my ($termtype) = grep(/(NT|TE)/, @info); + $termtype = 'TE' unless defined $termtype; + + $self->{IS_DIGITAL} = 1; + $self->{IS_PRI} = 1; + $self->{TERMTYPE} = $termtype; + $self->init_proto($proto); + last; + } + } + die "$0: Unkown TERMTYPE [NT/TE]\n" + if $self->is_digital and !defined $self->{TERMTYPE}; + ($self->{NAME}, $self->{DESCRIPTION}) = (split(/\s+/, $head, 4))[2, 3]; + $self->{IS_ZAPTEL_SYNC_MASTER} = + ($self->{DESCRIPTION} =~ /\(MASTER\)/) ? 1 : 0; + $self->{CHANS} = []; + my @channels; + my $index = 0; + while(<F>) { + chomp; + s/^\s*//; + s/\s*$//; + next unless /\S/; + next unless /^\s*\d+/; # must be a real channel string. + my $c = Zaptel::Chans->new($self, $index, $_); + push(@channels, $c); + $index++; + } + close F; + if($self->is_pri()) { + # Check for PRI with unknown type strings + if($index == 31) { + if($self->{PROTO} eq 'UNKNOWN') { + $self->init_proto('E1'); + } elsif($self->{PROTO} ne 'E1') { + die "$index channels in a $self->{PROTO} span"; + } + } elsif($index == 24) { + if($self->{PROTO} eq 'UNKNOWN') { + $self->init_proto('T1'); # FIXME: J1? + } elsif($self->{PROTO} ne 'T1') { + die "$index channels in a $self->{PROTO} span"; + } + } + } + @channels = sort { $a->num <=> $b->num } @channels; + $self->{CHANS} = \@channels; + $self->{YELLOW} = undef; + $self->{CRC4} = undef; + if($self->is_bri()) { + $self->{CODING} = 'ami'; + $self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}]; + $self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ]; + # Infer some info from channel name: + my $first_chan = ($self->chans())[0] || die "$0: No channels in span #$num\n"; + my $chan_fqn = $first_chan->fqn(); + if($chan_fqn =~ m(ZTHFC.*/|ztqoz.*/|XPP_BRI_.*/)) { # BRI + $self->{FRAMING} = 'ccs'; + $self->{SWITCHTYPE} = 'euroisdn'; + $self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $ZAPBRI_NET : $ZAPBRI_CPE ; + } elsif($chan_fqn =~ m(ztgsm.*/)) { # Junghanns's GSM cards. + $self->{FRAMING} = 'ccs'; + $self->{SIGNALLING} = 'gsm'; + } + } + if($self->is_pri()) { + $self->{DCHAN} = ($self->chans())[$self->{DCHAN_IDX}]; + $self->{BCHANS} = [ ($self->chans())[@{$self->{BCHAN_LIST}}] ]; + if($self->{PROTO} eq 'E1') { + $self->{CODING} = 'hdb3'; + $self->{FRAMING} = 'ccs'; + $self->{SWITCHTYPE} = 'euroisdn'; + $self->{CRC4} = 'crc4'; + } elsif($self->{PROTO} eq 'T1') { + $self->{CODING} = 'b8zs'; + $self->{FRAMING} = 'esf'; + $self->{SWITCHTYPE} = 'national'; + } else { + die "'$self->{PROTO}' unsupported yet"; + } + $self->{SIGNALLING} = ($self->{TERMTYPE} eq 'NT') ? $ZAPPRI_NET : $ZAPPRI_CPE ; + } + return $self; +} + +sub bchans($) { + my $self = shift || die; + + return @{$self->{BCHANS}}; +} + +1; diff --git a/xpp/zconf/Zaptel/Utils.pm b/xpp/zconf/Zaptel/Utils.pm new file mode 100644 index 0000000..8d13ad7 --- /dev/null +++ b/xpp/zconf/Zaptel/Utils.pm @@ -0,0 +1,52 @@ +package Zaptel::Utils; + +# Accessors (miniperl does not have Class:Accessor) +our $AUTOLOAD; +sub AUTOLOAD { + my $self = shift; + my $name = $AUTOLOAD; + $name =~ s/.*://; # strip fully-qualified portion + return if $name =~ /^[A-Z_]+$/; # ignore special methods (DESTROY) + my $key = uc($name); + my $val = shift; + if (defined $val) { + #print STDERR "set: $key = $val\n"; + return $self->{$key} = $val; + } else { + if(!exists $self->{$key}) { + #$self->xpp_dump; + #die "Trying to get uninitialized '$key'"; + } + my $val = $self->{$key}; + #print STDERR "get: $key ($val)\n"; + return $val; + } +} + +sub xpp_dump($) { + my $self = shift || die; + printf STDERR "Dump a %s\n", ref($self); + foreach my $k (sort keys %{$self}) { + my $val = $self->{$k}; + $val = '**UNDEF**' if !defined $val; + printf STDERR " %-20s %s\n", $k, $val; + } +} + +# Based on Autoloader + +sub import { + my $pkg = shift; + my $callpkg = caller; + + #print STDERR "import: $pkg, $callpkg\n"; + # + # Export symbols, but not by accident of inheritance. + # + die "Sombody inherited Zaptel::Utils" if $pkg ne 'Zaptel::Utils'; + no strict 'refs'; + *{ $callpkg . '::AUTOLOAD' } = \&AUTOLOAD; + *{ $callpkg . '::xpp_dump' } = \&xpp_dump; +} + +1; diff --git a/xpp/zconf/Zaptel/Xpp.pm b/xpp/zconf/Zaptel/Xpp.pm new file mode 100644 index 0000000..8b7458f --- /dev/null +++ b/xpp/zconf/Zaptel/Xpp.pm @@ -0,0 +1,199 @@ +package Zaptel::Xpp; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Xpp::Xbus; + +=head1 NAME + +Zaptel::Xpp - Perl interface to the Xorcom Astribank drivers. + +=head1 SYNOPSIS + + # Listing all Astribanks: + use Zaptel::Xpp; + # scans hardware: + my @xbuses = Zaptel::Xpp::xbuses("SORT_CONNECTOR"); + for my $xbus (@xbuses) { + print $xbus->name." (".$xbus->label .", ". $xbus->connector .")\n"; + for my $xpd ($xbus->xpds) { + print " - ".$xpd->fqn,"\n"; + } + } +=cut + + +my $proc_base = "/proc/xpp"; + +# Nominal sorters for xbuses +sub by_name { + return $a->name cmp $b->name; +} + +sub by_connector { + return $a->connector cmp $b->connector; +} + +sub by_label { + my $cmp = $a->label cmp $b->label; + return $cmp if $cmp != 0; + return $a->connector cmp $b->connector; +} + +=head1 xbuses([sort_order]) + +Scans system (/proc and /sys) and returns a list of Astribank (Xbus) +objects. The optional parameter sort_order is the order in which +the Astribanks will be returns: + +=over + +=item SORT_CONNECTOR + +Sort by the connector string. For USB this defines the "path" to get to +the device through controllers, hubs etc. + +=item SORT_LABEL + +Sorts by the label of the Astribank. The label field is unique to the +Astribank. It can also be viewed through 'lsusb -v' without the drivers +loaded (the iSerial field in the Device Descriptor). + +=item SORT_NAME + +Sort by the "name". e.g: "XBUS-00". The order of Astribank names depends +on the load order, and hence may change between different runs. + +=item custom function + +Instead of using a predefined sorter, you can pass your own sorting +function. See the example sorters in the code of this module. + +=back + +=cut + +sub xbuses { + my $optsort = shift || 'SORT_CONNECTOR'; + my @xbuses; + + -d "$proc_base" or return (); + my @lines; + local $/ = "\n"; + open(F, "$proc_base/xbuses") || + die "$0: Failed to open $proc_base/xbuses: $!\n"; + @lines = <F>; + close F; + foreach my $line (@lines) { + chomp $line; + my ($name, @attr) = split(/\s+/, $line); + $name =~ s/://; + $name =~ /XBUS-(\d\d)/ or die "Bad XBUS number: $name"; + my $num = $1; + @attr = map { split(/=/); } @attr; + my $xbus = Zaptel::Xpp::Xbus->new(NAME => $name, NUM => $num, @attr); + push(@xbuses, $xbus); + } + my $sorter; + if($optsort eq "SORT_CONNECTOR") { + $sorter = \&by_connector; + } elsif($optsort eq "SORT_NAME") { + $sorter = \&by_name; + } elsif($optsort eq "SORT_LABEL") { + $sorter = \&by_label; + } elsif(ref($optsort) eq 'CODE') { + $sorter = $optsort; + } else { + die "Unknown optional sorter '$optsort'"; + } + @xbuses = sort $sorter @xbuses; + return @xbuses; +} + +sub xpd_of_span($) { + my $span = shift or die "Missing span parameter"; + return undef unless defined $span; + foreach my $xbus (Zaptel::Xpp::xbuses('SORT_CONNECTOR')) { + foreach my $xpd ($xbus->xpds()) { + return $xpd if $xpd->fqn eq $span->name; + } + } + return undef; +} + +=head1 sync([new_sync_source]) + +Gets (and optionally sets) the internal Astribanks synchronization +source. When used to set sync source, returns the original sync source. + +A synchronization source is a value valid writing into /proc/xpp/sync . +For more information read that file and see README.Astribank . + +=cut + +sub sync { + my $newsync = shift; + my $result; + my $newapi = 0; + + my $file = "$proc_base/sync"; + return '' unless -f $file; + # First query + open(F, "$file") or die "Failed to open $file for reading: $!"; + while(<F>) { + chomp; + /SYNC=/ and $newapi = 1; + s/#.*//; + if(/\S/) { # First non-comment line + s/^SYNC=\D*// if $newapi; + $result = $_; + last; + } + } + close F; + if(defined($newsync)) { # Now change + $newsync =~ s/.*/\U$&/; + if($newsync =~ /^(\d+)$/) { + $newsync = ($newapi)? "SYNC=$1" : "$1 0"; + } elsif($newsync ne 'ZAPTEL') { + die "Bad sync parameter '$newsync'"; + } + open(F, ">$file") or die "Failed to open $file for writing: $!"; + print F $newsync; + close(F) or die "Failed in closing $file: $!"; + } + return $result; +} + +=head1 SEE ALSO + +=over + +=item L<Zaptel::Xpp::Xbus> + +Xbus (Astribank) object. + +=item L<Zaptel::Xpp::Xpd> + +XPD (the rough equivalent of a Zaptel span) object. + +=item L<Zaptel::Xpp::Line> + +Object for a line: an analog port or a time-slot in a adapter. +Equivalent of a channel in Zaptel. + +=item L<Zaptel> + +General documentation in the master package. + +=back + +=cut + +1; diff --git a/xpp/zconf/Zaptel/Xpp/Line.pm b/xpp/zconf/Zaptel/Xpp/Line.pm new file mode 100644 index 0000000..2472c3b --- /dev/null +++ b/xpp/zconf/Zaptel/Xpp/Line.pm @@ -0,0 +1,95 @@ +package Zaptel::Xpp::Line; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2008, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Utils; + +my $proc_base = "/proc/xpp"; + +sub new($$$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $xpd = shift or die; + my $index = shift; + defined $index or die; + my $self = {}; + bless $self, $pack; + $self->{XPD} = $xpd; + $self->{INDEX} = $index; + return $self; +} + +sub blink($$) { + my $self = shift; + my $on = shift; + my $xpd = $self->xpd; + my $result; + + my $file = "$proc_base/" . $xpd->fqn . "/blink"; + die "$file is missing" unless -f $file; + # First query + open(F, "$file") or die "Failed to open $file for reading: $!"; + $result = <F>; + chomp $result; + close F; + if(defined($on)) { # Now change + my $onbitmask = 1 << $self->index; + my $offbitmask = $result & ~$onbitmask; + + $result = $offbitmask; + $result |= $onbitmask if $on; + open(F, ">$file") or die "Failed to open $file for writing: $!"; + print F "$result"; + if(!close(F)) { + if($! == 17) { # EEXISTS + # good + } else { + undef $result; + } + } + } + return $result; +} + +sub create_all($$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $xpd = shift || die; + my $procdir = shift || die; + local $/ = "\n"; + my @lines; + for(my $i = 0; $i < $xpd->{CHANNELS}; $i++) { + my $line = Zaptel::Xpp::Line->new($xpd, $i); + push(@lines, $line); + } + $xpd->{LINES} = \@lines; + my ($infofile) = glob "$procdir/*_info"; + die "Failed globbing '$procdir/*_info'" unless defined $infofile; + my $type = $xpd->type; + open(F, "$infofile") || die "Failed opening '$infofile': $!"; + my $battery_info = 0; + while (<F>) { + chomp; + if($type eq 'FXO') { + $battery_info = 1 if /^Battery:/; + if($battery_info && s/^\s*on\s*:\s*//) { + my @batt = split; + foreach my $l (@lines) { + die unless @batt; + my $state = shift @batt; + $l->{BATTERY} = ($state eq '+') ? 1 : 0; + } + $battery_info = 0; + die if @batt; + } + } + } + close F; +} + + +1; diff --git a/xpp/zconf/Zaptel/Xpp/Xbus.pm b/xpp/zconf/Zaptel/Xpp/Xbus.pm new file mode 100644 index 0000000..e840f14 --- /dev/null +++ b/xpp/zconf/Zaptel/Xpp/Xbus.pm @@ -0,0 +1,118 @@ +package Zaptel::Xpp::Xbus; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Utils; +use Zaptel::Xpp::Xpd; + +my $proc_base = "/proc/xpp"; + +sub xpds($) { + my $xbus = shift; + return @{$xbus->{XPDS}}; +} + +sub by_number($) { + my $busnumber = shift; + die "Missing xbus number parameter" unless defined $busnumber; + my @xbuses = Zaptel::Xpp::xbuses(); + + my ($xbus) = grep { $_->num == $busnumber } @xbuses; + return $xbus; +} + +sub by_label($) { + my $label = shift; + die "Missing xbus label parameter" unless defined $label; + my @xbuses = Zaptel::Xpp::xbuses(); + + my ($xbus) = grep { $_->label eq $label } @xbuses; + return $xbus; +} + +sub get_xpd_by_number($$) { + my $xbus = shift; + my $xpdid = shift; + die "Missing XPD id parameter" unless defined $xpdid; + my @xpds = $xbus->xpds; + my ($wanted) = grep { $_->id eq $xpdid } @xpds; + return $wanted; +} + +sub new($$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $self = {}; + bless $self, $pack; + while(@_) { + my ($k, $v) = @_; + shift; shift; + # Keys in all caps + $k = uc($k); + # Some values are in all caps as well + if($k =~ /^(STATUS)$/) { + $v = uc($v); + } + $self->{$k} = $v; + } + # backward compat for drivers without labels. + if(!defined $self->{LABEL}) { + $self->{LABEL} = '[]'; + } + $self->{LABEL} =~ s/^\[(.*)\]$/$1/ or die "$self->{NAME}: Bad label"; + # Fix badly burned labels. + $self->{LABEL} =~ s/[[:^print:]]/_/g; + $self->{NAME} or die "Missing xbus name"; + my $prefix = "$proc_base/" . $self->{NAME}; + my $usbfile = "$prefix/xpp_usb"; + if(open(F, "$usbfile")) { + my $head = <F>; + chomp $head; + close F; + $head =~ s/^device: +([^, ]+)/$1/i or die; + $self->{USB_DEVNAME} = $head; + } + @{$self->{XPDS}} = (); + foreach my $dir (glob "$prefix/XPD-??") { + my $xpd = Zaptel::Xpp::Xpd->new($self, $dir); + push(@{$self->{XPDS}}, $xpd); + } + @{$self->{XPDS}} = sort { $a->id <=> $b->id } @{$self->{XPDS}}; + return $self; +} + +sub pretty_xpds($) { + my $xbus = shift; + my @xpds = sort { $a->id <=> $b->id } $xbus->xpds(); + my @xpd_types = map { $_->type } @xpds; + my $last_type = ''; + my $mult = 0; + my $xpdstr = ''; + foreach my $curr (@xpd_types) { + if(!$last_type || ($curr eq $last_type)) { + $mult++; + } else { + if($mult == 1) { + $xpdstr .= "$last_type "; + } elsif($mult) { + $xpdstr .= "$last_type*$mult "; + } + $mult = 1; + } + $last_type = $curr; + } + if($mult == 1) { + $xpdstr .= "$last_type "; + } elsif($mult) { + $xpdstr .= "$last_type*$mult "; + } + $xpdstr =~ s/\s*$//; # trim trailing space + return $xpdstr; +} + +1; diff --git a/xpp/zconf/Zaptel/Xpp/Xpd.pm b/xpp/zconf/Zaptel/Xpp/Xpd.pm new file mode 100644 index 0000000..1ddb5c8 --- /dev/null +++ b/xpp/zconf/Zaptel/Xpp/Xpd.pm @@ -0,0 +1,123 @@ +package Zaptel::Xpp::Xpd; +# +# Written by Oron Peled <oron@actcom.co.il> +# Copyright (C) 2007, Xorcom +# This program is free software; you can redistribute and/or +# modify it under the same terms as Perl itself. +# +# $Id$ +# +use strict; +use Zaptel::Utils; +use Zaptel::Xpp; +use Zaptel::Xpp::Line; + +my $proc_base = "/proc/xpp"; + +sub blink($$) { + my $self = shift; + my $on = shift; + my $result; + + my $file = "$proc_base/" . $self->fqn . "/blink"; + die "$file is missing" unless -f $file; + # First query + open(F, "$file") or die "Failed to open $file for reading: $!"; + $result = <F>; + chomp $result; + close F; + if(defined($on) and $on ne $result) { # Now change + open(F, ">$file") or die "Failed to open $file for writing: $!"; + print F ($on)?"0xFFFF":"0"; + if(!close(F)) { + if($! == 17) { # EEXISTS + # good + } else { + undef $result; + } + } + } + return $result; +} + +sub zt_registration($$) { + my $self = shift; + my $on = shift; + my $result; + + my $file = "$proc_base/" . $self->fqn . "/zt_registration"; + die "$file is missing" unless -f $file; + # First query + open(F, "$file") or die "Failed to open $file for reading: $!"; + $result = <F>; + chomp $result; + close F; + if(defined($on) and $on ne $result) { # Now change + open(F, ">$file") or die "Failed to open $file for writing: $!"; + print F ($on)?"1":"0"; + if(!close(F)) { + if($! == 17) { # EEXISTS + # good + } else { + undef $result; + } + } + } + return $result; +} + +sub xpds_by_spanno() { + my @xbuses = Zaptel::Xpp::xbuses("SORT_CONNECTOR"); + my @xpds = map { $_->xpds } @xbuses; + @xpds = grep { $_->spanno } @xpds; + @xpds = sort { $a->spanno <=> $b->spanno } @xpds; + my @spanno = map { $_->spanno } @xpds; + my @idx; + @idx[@spanno] = @xpds; # The spanno is the index now + return @idx; +} + +sub new($$) { + my $pack = shift or die "Wasn't called as a class method\n"; + my $xbus = shift || die; + my $procdir = shift || die; + my $self = {}; + bless $self, $pack; + $self->{XBUS} = $xbus; + $self->{DIR} = $procdir; + local $/ = "\n"; + open(F, "$procdir/summary") || die "Missing summary file in $procdir"; + my $head = <F>; + chomp $head; # "XPD-00 (BRI_TE ,card present, span 3)" + # The driver does not export the number of channels... + # Let's find it indirectly + while(<F>) { + chomp; + if(s/^\s*offhook\s*:\s*//) { + my @offhook = split; + @offhook || die "No channels in '$procdir/summary'"; + $self->{CHANNELS} = @offhook; + last; + } + } + close F; + $head =~ s/^(XPD-(\d\d))\s+// || die; + $self->{ID} = $2; + $self->{FQN} = $xbus->name . "/" . $1; + $head =~ s/^.*\(// || die; + $head =~ s/\) */, / || die; + $head =~ s/\s*,\s*/,/g || die; + my ($type,$present,$span,$rest) = split(/,/, $head); + #warn "Garbage in '$procdir/summary': rest='$rest'\n" if $rest; + if($span =~ s/span\s+(\d+)//) { # since changeset:5119 + $self->{SPANNO} = $1; + } + $self->{TYPE} = $type; + $self->{IS_BRI} = ($type =~ /BRI_(NT|TE)/); + $self->{IS_PRI} = ($type =~ /[ETJ]1_(NT|TE)/); + $self->{IS_DIGITAL} = ( $self->{IS_BRI} || $self->{IS_PRI} ); + Zaptel::Xpp::Line->create_all($self, $procdir); + return $self; +} + +1; |