From c1ae88873823bdc2d884f72cc2b06eab017b97b1 Mon Sep 17 00:00:00 2001 From: Tzafrir Cohen Date: Thu, 19 Jun 2008 17:23:15 +0000 Subject: XPP utilities rename: first moves. git-svn-id: http://svn.asterisk.org/svn/dahdi/tools/trunk@4415 a0bf4364-ded3-4de4-8d8a-66a801d63aff --- xpp/zconf/Zaptel/Chans.pm | 202 ------------------------ xpp/zconf/Zaptel/Config/Defaults.pm | 56 ------- xpp/zconf/Zaptel/Hardware.pm | 168 -------------------- xpp/zconf/Zaptel/Hardware/PCI.pm | 208 ------------------------- xpp/zconf/Zaptel/Hardware/USB.pm | 116 -------------- xpp/zconf/Zaptel/Span.pm | 300 ------------------------------------ xpp/zconf/Zaptel/Utils.pm | 52 ------- xpp/zconf/Zaptel/Xpp.pm | 199 ------------------------ xpp/zconf/Zaptel/Xpp/Line.pm | 95 ------------ xpp/zconf/Zaptel/Xpp/Xbus.pm | 118 -------------- xpp/zconf/Zaptel/Xpp/Xpd.pm | 123 --------------- 11 files changed, 1637 deletions(-) delete mode 100644 xpp/zconf/Zaptel/Chans.pm delete mode 100644 xpp/zconf/Zaptel/Config/Defaults.pm delete mode 100644 xpp/zconf/Zaptel/Hardware.pm delete mode 100644 xpp/zconf/Zaptel/Hardware/PCI.pm delete mode 100644 xpp/zconf/Zaptel/Hardware/USB.pm delete mode 100644 xpp/zconf/Zaptel/Span.pm delete mode 100644 xpp/zconf/Zaptel/Utils.pm delete mode 100644 xpp/zconf/Zaptel/Xpp.pm delete mode 100644 xpp/zconf/Zaptel/Xpp/Line.pm delete mode 100644 xpp/zconf/Zaptel/Xpp/Xbus.pm delete mode 100644 xpp/zconf/Zaptel/Xpp/Xpd.pm (limited to 'xpp/zconf/Zaptel') diff --git a/xpp/zconf/Zaptel/Chans.pm b/xpp/zconf/Zaptel/Chans.pm deleted file mode 100644 index 6f83f77..0000000 --- a/xpp/zconf/Zaptel/Chans.pm +++ /dev/null @@ -1,202 +0,0 @@ -package Zaptel::Chans; -# -# Written by Oron Peled -# 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 -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 deleted file mode 100644 index 360ca0a..0000000 --- a/xpp/zconf/Zaptel/Config/Defaults.pm +++ /dev/null @@ -1,56 +0,0 @@ -package Zaptel::Config::Defaults; -# -# Written by Oron Peled -# 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 deleted file mode 100644 index ff7aeea..0000000 --- a/xpp/zconf/Zaptel/Hardware.pm +++ /dev/null @@ -1,168 +0,0 @@ -package Zaptel::Hardware; -# -# Written by Oron Peled -# 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 deleted file mode 100644 index a63b09f..0000000 --- a/xpp/zconf/Zaptel/Hardware/PCI.pm +++ /dev/null @@ -1,208 +0,0 @@ -package Zaptel::Hardware::PCI; -# -# Written by Oron Peled -# 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 = ; - close F; - chomp($str); - return $str; -} - -sub scan_devices($) { - my @devices; - - while() { - 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() { - 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 deleted file mode 100644 index a2dc08f..0000000 --- a/xpp/zconf/Zaptel/Hardware/USB.pm +++ /dev/null @@ -1,116 +0,0 @@ -package Zaptel::Hardware::USB; -# -# Written by Oron Peled -# 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() { - 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 deleted file mode 100644 index 9aceb78..0000000 --- a/xpp/zconf/Zaptel/Span.pm +++ /dev/null @@ -1,300 +0,0 @@ -package Zaptel::Span; -# -# Written by Oron Peled -# 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 for usage example. Specifically -C 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 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/dahdi"; - -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 = ; - 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() { - 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 deleted file mode 100644 index 8d13ad7..0000000 --- a/xpp/zconf/Zaptel/Utils.pm +++ /dev/null @@ -1,52 +0,0 @@ -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 deleted file mode 100644 index 8b7458f..0000000 --- a/xpp/zconf/Zaptel/Xpp.pm +++ /dev/null @@ -1,199 +0,0 @@ -package Zaptel::Xpp; -# -# Written by Oron Peled -# 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 = ; - 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() { - 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 - -Xbus (Astribank) object. - -=item L - -XPD (the rough equivalent of a Zaptel span) object. - -=item L - -Object for a line: an analog port or a time-slot in a adapter. -Equivalent of a channel in Zaptel. - -=item L - -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 deleted file mode 100644 index 2472c3b..0000000 --- a/xpp/zconf/Zaptel/Xpp/Line.pm +++ /dev/null @@ -1,95 +0,0 @@ -package Zaptel::Xpp::Line; -# -# Written by Oron Peled -# 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 = ; - 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 () { - 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 deleted file mode 100644 index e840f14..0000000 --- a/xpp/zconf/Zaptel/Xpp/Xbus.pm +++ /dev/null @@ -1,118 +0,0 @@ -package Zaptel::Xpp::Xbus; -# -# Written by Oron Peled -# 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 = ; - 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 deleted file mode 100644 index 5087f1f..0000000 --- a/xpp/zconf/Zaptel/Xpp/Xpd.pm +++ /dev/null @@ -1,123 +0,0 @@ -package Zaptel::Xpp::Xpd; -# -# Written by Oron Peled -# 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 = ; - 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 dahdi_registration($$) { - my $self = shift; - my $on = shift; - my $result; - - my $file = "$proc_base/" . $self->fqn . "/dahdi_registration"; - die "$file is missing" unless -f $file; - # First query - open(F, "$file") or die "Failed to open $file for reading: $!"; - $result = ; - 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 = ; - 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() { - 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; -- cgit v1.2.3