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/dahdi_drivers | 9 + xpp/dahdi_genconf | 603 +++++++++++++++++++++++++++++ xpp/dahdi_hardware | 164 ++++++++ xpp/lsdahdi | 108 ++++++ xpp/lszaptel | 108 ------ xpp/perl_modules/Zaptel.pm | 68 ++++ xpp/perl_modules/Zaptel/Chans.pm | 202 ++++++++++ xpp/perl_modules/Zaptel/Config/Defaults.pm | 56 +++ xpp/perl_modules/Zaptel/Hardware.pm | 168 ++++++++ xpp/perl_modules/Zaptel/Hardware/PCI.pm | 208 ++++++++++ xpp/perl_modules/Zaptel/Hardware/USB.pm | 116 ++++++ xpp/perl_modules/Zaptel/Span.pm | 300 ++++++++++++++ xpp/perl_modules/Zaptel/Utils.pm | 52 +++ xpp/perl_modules/Zaptel/Xpp.pm | 199 ++++++++++ xpp/perl_modules/Zaptel/Xpp/Line.pm | 95 +++++ xpp/perl_modules/Zaptel/Xpp/Xbus.pm | 118 ++++++ xpp/perl_modules/Zaptel/Xpp/Xpd.pm | 123 ++++++ xpp/zapconf | 603 ----------------------------- xpp/zaptel-helper | 401 ------------------- xpp/zaptel_drivers | 9 - xpp/zaptel_hardware | 164 -------- xpp/zconf/Zaptel.pm | 68 ---- 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 ------ 33 files changed, 2589 insertions(+), 2990 deletions(-) create mode 100755 xpp/dahdi_drivers create mode 100755 xpp/dahdi_genconf create mode 100755 xpp/dahdi_hardware create mode 100755 xpp/lsdahdi delete mode 100755 xpp/lszaptel create mode 100644 xpp/perl_modules/Zaptel.pm create mode 100644 xpp/perl_modules/Zaptel/Chans.pm create mode 100644 xpp/perl_modules/Zaptel/Config/Defaults.pm create mode 100644 xpp/perl_modules/Zaptel/Hardware.pm create mode 100644 xpp/perl_modules/Zaptel/Hardware/PCI.pm create mode 100644 xpp/perl_modules/Zaptel/Hardware/USB.pm create mode 100644 xpp/perl_modules/Zaptel/Span.pm create mode 100644 xpp/perl_modules/Zaptel/Utils.pm create mode 100644 xpp/perl_modules/Zaptel/Xpp.pm create mode 100644 xpp/perl_modules/Zaptel/Xpp/Line.pm create mode 100644 xpp/perl_modules/Zaptel/Xpp/Xbus.pm create mode 100644 xpp/perl_modules/Zaptel/Xpp/Xpd.pm delete mode 100755 xpp/zapconf delete mode 100644 xpp/zaptel-helper delete mode 100755 xpp/zaptel_drivers delete mode 100755 xpp/zaptel_hardware delete mode 100644 xpp/zconf/Zaptel.pm 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 diff --git a/xpp/dahdi_drivers b/xpp/dahdi_drivers new file mode 100755 index 0000000..d7904c0 --- /dev/null +++ b/xpp/dahdi_drivers @@ -0,0 +1,9 @@ +#! /usr/bin/perl -w +use strict; +use File::Basename; +BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } + +use Zaptel::Hardware; + +my $hardware = Zaptel::Hardware->scan; +print join("\n", $hardware->drivers),"\n"; diff --git a/xpp/dahdi_genconf b/xpp/dahdi_genconf new file mode 100755 index 0000000..7f94f6b --- /dev/null +++ b/xpp/dahdi_genconf @@ -0,0 +1,603 @@ +#! /usr/bin/perl -w +# +# 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 File::Basename; +BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } + +use Zaptel; +use Zaptel::Xpp; +use Zaptel::Config::Defaults; + +my %default_context = ( + FXO => 'from-pstn', + FXS => 'from-internal', + IN => 'astbank-input', + OUT => 'astbank-output', + BRI_TE => 'from-pstn', + BRI_NT => 'from-internal', + E1_TE => 'from-pstn', + T1_TE => 'from-pstn', + J1_TE => 'from-pstn', + E1_NT => 'from-internal', + T1_NT => 'from-internal', + J1_NT => 'from-internal', + ); + +my %default_group = ( + FXO => 0, + FXS => "5", + IN => '', + OUT => '', + BRI_TE => 0, + BRI_NT => 6, + E1_TE => 0, + T1_TE => 0, + J1_TE => 0, + E1_NT => 6, + T1_NT => 6, + J1_NT => 6, + ); + +my $fxs_default_start = 'ls'; + +my %default_zaptel_signalling = ( + FXO => 'fxsks', + FXS => "fxo{fxs_default_start}", + IN => "fxo{fxs_default_start}", + OUT => "fxo{fxs_default_start}", + ); + +my %default_zapata_signalling = ( + FXO => 'fxs_ks', + FXS => "fxo_{fxs_default_start}", + IN => "fxo_{fxs_default_start}", + OUT => "fxo_{fxs_default_start}", + ); + +my $base_exten = 4000; +my $fxs_immediate = 'no'; +my $lc_country = 'us'; +my $loadzone = $lc_country; +my $defaultzone = $lc_country; +my $bri_sig_style = 'bri_ptmp'; +my $brint_overlap = 'no'; + +my %zaptel_default_vars = ( + base_exten => \$base_exten, + fxs_immediate => \$fxs_immediate, + fxs_default_start => \$fxs_default_start, + lc_country => [ + \$loadzone, + \$defaultzone, + ], + context_lines => \$default_context{FXO}, + context_phones => \$default_context{FXS}, + context_input => \$default_context{IN}, + context_output => \$default_context{OUT}, + group_phones => [ + \$default_group{FXS}, + \$default_group{IN}, + \$default_group{OUT}, + ], + group_lines => \$default_group{FXO}, + ZAPBRI_SIGNALLING => \$bri_sig_style, + brint_overlap => \$brint_overlap, + ); + +sub map_zaptel_defaults { + my %defaults = @_; + foreach my $name (keys %defaults) { + my $val = $defaults{$name}; + my $ref = $zaptel_default_vars{$name}; + my $type = ref $ref; + my @vars = (); + # Some broken shells (msh) export even variables + # That where not defined. Work around that. + next unless defined $val && $val ne ''; + if($type eq 'SCALAR') { + @vars = ($ref); + } elsif($type eq 'ARRAY') { + @vars = @$ref; + } else { + die "$0: Don't know how to map '$name' (type=$type)\n"; + } + foreach my $v (@vars) { + $$v = $val; + } + } +} + + +my $zapconf_file; +my $zapatachannels_file; +my $users_file; +my $zapataconf_file; + +my %files = ( + zaptel => { file => \$zapconf_file, func => \&gen_zaptelconf }, + zapata => { file => \$zapatachannels_file, func => \&gen_zapatachannelsconf }, + users => { file => \$users_file, func => \&gen_usersconf }, + zapataconf => { file => \$zapataconf_file, func => \&gen_zapataconf }, +); + +my @default_files = ("zaptel", "zapata"); + +my @spans = Zaptel::spans(); + +sub bchan_range($) { + my $span = shift || die; + my $first_chan = ($span->chans())[0]; + my $first_num = $first_chan->num(); + my $range_start = $first_num; + my @range; + my $prev = undef; + + die unless $span->is_digital(); + foreach my $c (@{$span->bchan_list()}) { + my $curr = $c + $first_num; + if(!defined($prev)) { + $prev = $curr; + } elsif($curr != $prev + 1) { + push(@range, sprintf("%d-%d", $range_start, $prev)); + $range_start = $curr; + } + $prev = $curr; + } + if($prev >= $first_num) { + push(@range, sprintf("%d-%d", $range_start, $prev)); + } + return join(',', @range); +} + +sub gen_zaptel_signalling($) { + my $chan = shift || die; + my $type = $chan->type; + my $num = $chan->num; + + die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital(); + if($type eq 'EMPTY') { + printf "# channel %d, %s, no module.\n", $num, $chan->fqn; + return; + } + my $sig = $default_zaptel_signalling{$type} || die "unknown default zaptel signalling for chan $chan type $type"; + if ($type eq 'IN') { + printf "# astbanktype: input\n"; + } elsif ($type eq 'OUT') { + printf "# astbanktype: output\n"; + } + printf "$sig=$num\n"; +} + +my $bri_te_last_timing = 1; + +sub gen_zaptel_digital($) { + my $span = shift || die; + my $num = $span->num() || die; + die "Span #$num is analog" unless $span->is_digital(); + my $termtype = $span->termtype() || die "$0: Span #$num -- unkown termtype [NT/TE]\n"; + my $timing; + my $lbo = 0; + my $framing = $span->framing() || die "$0: No framing information for span #$num\n"; + my $coding = $span->coding() || die "$0: No coding information for span #$num\n"; + my $span_crc4 = $span->crc4(); + $span_crc4 = (defined $span_crc4) ? ",$span_crc4" : ''; + my $span_yellow = $span->yellow(); + $span_yellow = (defined $span_yellow) ? ",$span_yellow" : ''; + + $timing = ($termtype eq 'NT') ? 0 : $bri_te_last_timing++; + printf "span=%d,%d,%d,%s,%s%s%s\n", + $num, + $timing, + $lbo, + $framing, + $coding, + $span_crc4, + $span_yellow; + printf "# termtype: %s\n", lc($termtype); + printf "bchan=%s\n", bchan_range($span); + my $dchan = $span->dchan(); + printf "dchan=%d\n", $dchan->num(); +} + +sub gen_zaptelconf($) { + my $file = shift || die; + rename "$file", "$file.bak" + or $! == 2 # ENOENT (No dependency on Errno.pm) + or die "Failed to backup old config: $!\n"; + open(F, ">$file") || die "$0: Failed to open $file: $!\n"; + my $old = select F; + printf "# Autogenerated by %s on %s -- do not hand edit\n", $0, scalar(localtime); + print <<"HEAD"; +# Zaptel Configuration File +# +# This file is parsed by the Zaptel Configurator, ztcfg +# +HEAD + foreach my $span (@spans) { + printf "# Span %d: %s %s\n", $span->num, $span->name, $span->description; + if($span->is_digital()) { + gen_zaptel_digital($span); + } else { + foreach my $chan ($span->chans()) { + if(1 || !defined $chan->type) { + my $type = $chan->probe_type; + my $num = $chan->num; + die "Failed probing type for channel $num" + unless defined $type; + $chan->type($type); + } + gen_zaptel_signalling($chan); + } + } + print "\n"; + } + print <<"TAIL"; +# Global data + +loadzone = $loadzone +defaultzone = $defaultzone +TAIL + close F; + select $old; +} + +my %DefaultConfigs = ( + context => 'default', + group => '63', # FIXME: should not be needed. + overlapdial => 'no', + busydetect => 'no', + rxgain => 0, + txgain => 0, +); + +sub reset_zapata_values { + foreach my $arg (@_) { + if (exists $DefaultConfigs{$arg}) { + print "$arg = $DefaultConfigs{$arg}\n"; + } else { + print "$arg =\n"; + } + } +} + +sub gen_zapata_digital($) { + my $span = shift || die; + my $num = $span->num() || die; + die "Span #$num is analog" unless $span->is_digital(); + my $type = $span->type() || die "$0: Span #$num -- unkown type\n"; + my $termtype = $span->termtype() || die "$0: Span #$num -- unkown termtype [NT/TE]\n"; + my $group = $default_group{"$type"}; + my $context = $default_context{"$type"}; + my @to_reset = qw/context group/; + + die "$0: missing default group (termtype=$termtype)\n" unless defined($group); + die "$0: missing default context\n" unless $context; + + my $sig = $span->signalling || die "missing signalling info for span #$num type $type"; + grep($bri_sig_style eq $_, 'bri', 'bri_ptmp', 'pri') or die "unknown signalling style for BRI"; + if($span->is_bri() and $bri_sig_style eq 'bri_ptmp') { + $sig .= '_ptmp'; + } + if ($span->is_bri() && $termtype eq 'NT' && $brint_overlap eq 'yes') { + print "overlapdial = yes\n"; + push(@to_reset, qw/overlapdial/); + } + + $group .= "," . (10 + $num); # Invent unique group per span + printf "group=$group\n"; + printf "context=$context\n"; + printf "switchtype = %s\n", $span->switchtype; + printf "signalling = %s\n", $sig; + printf "channel => %s\n", bchan_range($span); + reset_zapata_values(@to_reset); +} + +sub gen_zapata_channel($) { + my $chan = shift || die; + my $type = $chan->type; + my $num = $chan->num; + die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital(); + my $exten = $base_exten + $num; + my $sig = $default_zapata_signalling{$type}; + my $context = $default_context{$type}; + my $group = $default_group{$type}; + my $callerid; + my $immediate; + + return if $type eq 'EMPTY'; + die "missing default_zapata_signalling for chan #$num type $type" unless $sig; + $callerid = ($type eq 'FXO') + ? 'asreceived' + : sprintf "\"Channel %d\" <%04d>", $num, $exten; + if($type eq 'IN') { + $immediate = 'yes'; + } + # FIXME: $immediage should not be set for 'OUT' channels, but meanwhile + # it's better to be compatible with genzaptelconf + $immediate = 'yes' if $fxs_immediate eq 'yes' and $sig =~ /^fxo_/; + my $signalling = $chan->signalling; + $signalling = " " . $signalling if $signalling; + my $info = $chan->info; + $info = " " . $info if $info; + printf ";;; line=\"%d %s%s%s\"\n", $num, $chan->fqn, $signalling, $info; + printf "signalling=$sig\n"; + printf "callerid=$callerid\n"; + printf "mailbox=%04d\n", $exten unless $type eq 'FXO'; + if(defined $group) { + printf "group=$group\n"; + } + printf "context=$context\n"; + printf "immediate=$immediate\n" if defined $immediate; + printf "channel => %d\n", $num; + # Reset following values to default + printf "callerid=\n"; + printf "mailbox=\n" unless $type eq 'FXO'; + if(defined $group) { + printf "group=\n"; + } + printf "context=default\n"; + printf "immediate=no\n" if defined $immediate; + print "\n"; +} + +sub gen_zapatachannelsconf($) { + my $file = shift || die; + rename "$file", "$file.bak" + or $! == 2 # ENOENT (No dependency on Errno.pm) + or die "Failed to backup old config: $!\n"; + open(F, ">$file") || die "$0: Failed to open $file: $!\n"; + my $old = select F; + printf "; Autogenerated by %s on %s -- do not hand edit\n", $0, scalar(localtime); + print <<"HEAD"; +; Zaptel Channels Configurations (zapata.conf) +; +; This is not intended to be a complete zapata.conf. Rather, it is intended +; to be #include-d by /etc/zapata.conf that will include the global settings +; + +HEAD + foreach my $span (@spans) { + printf "; Span %d: %s %s\n", $span->num, $span->name, $span->description; + if($span->is_digital()) { + gen_zapata_digital($span); + } else { + foreach my $chan ($span->chans()) { + gen_zapata_channel($chan); + } + } + print "\n"; + } + close F; + select $old; +} + +sub gen_users_channel($) { + my $chan = shift || die; + my $type = $chan->type; + my $num = $chan->num; + die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital(); + my $exten = $base_exten + $num; + my $sig = $default_zapata_signalling{$type}; + my $full_name = "$type $num"; + + die "missing default_zapata_signalling for chan #$num type $type" unless $sig; + print << "EOF"; +[$exten] +callwaiting = yes +context = numberplan-custom-1 +fullname = $full_name +cid_number = $exten +hasagent = no +hasdirectory = no +hasiax = no +hasmanager = no +hassip = no +hasvoicemail = yes +host = dynamic +mailbox = $exten +threewaycalling = yes +vmsecret = 1234 +secret = 1234 +signalling = $sig +zapchan = $num +registeriax = no +registersip = no +canreinvite = no +nat = no +dtmfmode = rfc2833 +disallow = all +allow = all + +EOF +} + +# generate users.conf . The specific users.conf is strictly oriented +# towards using with the asterisk-gui . +# +# This code could have generated a much simpler and smaller +# configuration file, had there been minimal level of support for +# configuration templates in the asterisk configuration rewriting. Right +# now Asterisk's configuration rewriting simply freaks out in the face +# of templates: http://bugs.digium.com/11442 . +sub gen_usersconf($) { + my $file = shift || die; + rename "$file", "$file.bak" + or $! == 2 # ENOENT (No dependency on Errno.pm) + or die "Failed to backup old config: $!\n"; + open(F, ">$file") || die "$0: Failed to open $file: $!\n"; + my $old = select F; + print <<"HEAD"; +;! +;! Automatically generated configuration file +;! Filename: @{[basename($file)]} ($file) +;! Generator: $0 +;! Creation Date: @{[scalar(localtime)]} +;! +[general] +; +; Full name of a user +; +fullname = New User +; +; Starting point of allocation of extensions +; +userbase = @{[$base_exten+1]} +; +; Create voicemail mailbox and use use macro-stdexten +; +hasvoicemail = yes +; +; Set voicemail mailbox @{[$base_exten+1]} password to 1234 +; +vmsecret = 1234 +; +; Create SIP Peer +; +hassip = no +; +; Create IAX friend +; +hasiax = no +; +; Create Agent friend +; +hasagent = no +; +; Create H.323 friend +; +;hash323 = yes +; +; Create manager entry +; +hasmanager = no +; +; Remaining options are not specific to users.conf entries but are general. +; +callwaiting = yes +threewaycalling = yes +callwaitingcallerid = yes +transfer = yes +canpark = yes +cancallforward = yes +callreturn = yes +callgroup = 1 +pickupgroup = 1 +localextenlength = @{[length($base_exten)]} + + +HEAD + foreach my $span (@spans) { + next unless grep { $_ eq $span->type} ( 'FXS', 'IN', 'OUT' ); + printf "; Span %d: %s %s\n", $span->num, $span->name, $span->description; + foreach my $chan ($span->chans()) { + gen_users_channel($chan); + } + print "\n"; + } + close F; + select $old; +} + +sub gen_zapataconf($) { + my $file = shift || die; + open(F, ">>$file") || die "$0: Failed to open $file: $!\n"; + my $old = select F; + foreach my $span (@spans) { + next unless $span->type eq 'FXO'; + my $current_sig = ""; + for my $chan ($span->chans()) { + my $chan_num = $chan->num; + if ($default_zapata_signalling{$chan->type} ne $current_sig) { + $current_sig = $default_zapata_signalling{$chan->type}; + print "\nsignalling = $current_sig"; + print "\nchannel => $chan_num"; + } else { + print ",$chan_num"; + } + } + print "\n"; + } + close F; + select $old; +} + +sub set_defaults { + # Source default files + my ($default_file, %source_defaults) = + Zaptel::Config::Defaults::source_vars(keys(%zaptel_default_vars)); + map_zaptel_defaults(%source_defaults); + # Fixups + foreach my $val (values %default_zaptel_signalling, values %default_zapata_signalling) { + $val =~ s/{fxs_default_start}/$fxs_default_start/g; + } + $zapconf_file = $ENV{ZAPCONF_FILE} || "/etc/zaptel.conf"; + $zapatachannels_file = $ENV{ZAPATA_FILE} || "/etc/asterisk/zapata-channels.conf"; + $users_file = $ENV{USERS_FILE} || "/etc/asterisk/users.conf"; + $zapataconf_file = $ENV{ZAPATACONF_FILE} || "/etc/asterisk/zapata.conf"; +} + +sub parse_args { + return if @ARGV == 0; + @default_files = (); + for my $file (@ARGV) { + die "$0: Unknown file '$file'" unless defined $files{$file}; + push @default_files, $file; + } +} + +sub generate_files { + for my $file (@default_files) { + &{$files{$file}->{func}}(${$files{$file}->{file}}); + } +} +set_defaults; +parse_args; +generate_files; + +__END__ + +=head1 NAME + +zapconf - Generate configuration for zaptel channels. + +=head1 SYNOPSIS + +zapconf [FILES...] + +=head1 DESCRIPTION + +This script generate configuration files for Zaptel hardware. +Currently it can generate three files: zaptel, zapata, users and zapataconf (see below). +Without arguments, it generates only zaptel and zapata. + +=over 4 + +=item zaptel - /etc/zaptel.conf + +Configuration for ztcfg(1). It's location may be overriden by the +environment variable ZAPCONF_FILE. + +=item zapata - /etc/asterisk/zapata-channels.conf + +Configuration for asterisk(1). It should be included in the main /etc/asterisk/zapata.conf. +It's location may be overriden by the environment variable ZAPATA_FILE. + +=item users - /etc/asterisk/users.conf + +Configuration for asterisk(1) and AsteriskGUI. +It's location may be overriden by the environment variable USERS_FILE. + +=item zapataconf - /etc/asterisk/zapata.conf + +Configuration for asterisk(1) and AsteriskGUI. +It's location may be overriden by the environment variable ZAPATACONF_FILE. + + +=back diff --git a/xpp/dahdi_hardware b/xpp/dahdi_hardware new file mode 100755 index 0000000..004a44b --- /dev/null +++ b/xpp/dahdi_hardware @@ -0,0 +1,164 @@ +#! /usr/bin/perl -w +# +# 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 File::Basename; +use Getopt::Std; +BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } + +use Zaptel; +use Zaptel::Span; +use Zaptel::Xpp; +use Zaptel::Xpp::Xbus; +use Zaptel::Hardware; + +sub usage { + die "Usage: $0 [-v][-x]\n"; +} + +our ($opt_v, $opt_x); +getopts('vx') || usage; +@ARGV == 0 or usage; + +my $hardware = Zaptel::Hardware->scan; +my @spans = Zaptel::spans; + +sub show_xbus($) { + my $xbus = shift or die; + my @xpds = $xbus->xpds; + my $label = '[' . $xbus->label() . ']'; + my $connector = ($xbus->status eq 'CONNECTED') ? $xbus->connector : "MISSING"; + printf " LABEL=%-20s CONNECTOR=%-20s\n", $label, $connector; + foreach my $xpd (@xpds) { + my $reg = $xpd->zt_registration; + my $span; + my $spanstr; + if($reg && @spans) { + ($span) = grep { $_->name eq $xpd->fqn } @spans; + $spanstr = ($span) ? ("Span " . $span->num) : ""; + } else { + $spanstr = "Unregistered"; + } + my $master = ''; + #$master = "XPP-SYNC" if $xpd->is_sync_master; + $master .= " ZAPTEL-SYNC" if defined($span) && $span->is_zaptel_sync_master; + printf "\t%-10s: %-8s %s %s\n", $xpd->fqn, $xpd->type, $spanstr, $master; + } +} + +my %seen; +my $format = "%-20s %-12s %4s:%4s %s\n"; + +sub show_disconnected(%) { + my %seen = @_; + + my $notified_lost = 0; + foreach my $xbus (Zaptel::Xpp::xbuses('SORT_CONNECTOR')) { + if(!$seen{$xbus->name}) { + print "----------- XPP Spans with disconnected hardware -----------\n" + unless $notified_lost++; + printf($format, $xbus->name, '', '', '', "NO HARDWARE"); + show_xbus($xbus) if $opt_v; + } + } +} + +foreach my $dev ($hardware->device_list) { + my $driver = $dev->driver || ""; + my $xbus; + my $loaded; + if($dev->is_astribank) { + $xbus = $dev->xbus; + } + $loaded = $dev->loaded; + warn "driver should be '$driver' but is actually '$loaded'\n" + if defined($loaded) && $driver ne $loaded; + $driver = "$driver" . (($loaded) ? "+" : "-"); + my $description = $dev->description || ""; + printf $format, $dev->hardware_name, $driver, $dev->vendor, $dev->product, $description; + if(!defined $xbus || !$xbus) { + next; + } + $seen{$xbus->name} = 1; + show_xbus($xbus) if $opt_v; +} + +show_disconnected(%seen) if $opt_x; + +__END__ + +=head1 NAME + +zaptel_hardware - Shows Zaptel hardware devices. + +=head1 SYNOPSIS + +zaptel_hardware [-v][-x] + +=head1 OPTIONS + +=over + +=item -v + +Verbose ouput - show spans used by each device etc. Currently only +implemented for the Xorcom Astribank. + +=item -x + +Show disconnected Astribank unit, if any. + +=back + +=head1 DESCRIPTION + +Show all zaptel hardware devices. Devices are recognized according to +lists of PCI and USB IDs in Zaptel::Hardware::PCI.pm and +Zaptel::Hardware::USB.pm . For PCI it is possible to detect by +sub-vendor and sub-product ID as well. + +The first output column is the connector: a bus specific field that +shows where this device is. + +The second field shows which driver should handle the device. a "-" sign +marks that the device is not yet handled by this driver. A "+" sign +means that the device is handled by the driver. + +For the Xorcom Astribank (and in the future: for other Zaptel devices) +some further information is provided from the driver. Those extra lines +always begin with spaces. + +Example output: + +Without drivers loaded: + + usb:001/002 xpp_usb- e4e4:1152 Astribank-multi FPGA-firmware + usb:001/003 xpp_usb- e4e4:1152 Astribank-multi FPGA-firmware + pci:0000:01:0b.0 wctdm- e159:0001 Wildcard TDM400P REV H + +With drivers loaded, without -v: + usb:001/002 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware + usb:001/003 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware + pci:0000:01:0b.0 wctdm+ e159:0001 Wildcard TDM400P REV E/F + +With drivers loaded, with -v: + usb:001/002 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware + LABEL=[usb:123] CONNECTOR=usb-0000:00:1d.7-1 + XBUS-00/XPD-00: FXS Span 2 + XBUS-00/XPD-10: FXS Span 3 + XBUS-00/XPD-20: FXS Span 4 + XBUS-00/XPD-30: FXS Span 5 + usb:001/003 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware + LABEL=[usb:4567] CONNECTOR=usb-0000:00:1d.7-4 + XBUS-01/XPD-00: FXS Span 6 XPP-SYNC + XBUS-01/XPD-10: FXO Span 7 + XBUS-01/XPD-20: FXO Span 8 + XBUS-01/XPD-30: FXO Span 9 + pci:0000:01:0b.0 wctdm+ e159:0001 Wildcard TDM400P REV E/F + diff --git a/xpp/lsdahdi b/xpp/lsdahdi new file mode 100755 index 0000000..a836d98 --- /dev/null +++ b/xpp/lsdahdi @@ -0,0 +1,108 @@ +#! /usr/bin/perl -w +# +# 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 File::Basename; +BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } + +use Zaptel; +use Zaptel::Span; +use Zaptel::Xpp; +use Zaptel::Xpp::Xbus; +use Zaptel::Xpp::Xpd; + +my @xbuses = Zaptel::Xpp::xbuses("SORT_CONNECTOR"); +my @xpds = map { $_->xpds } @xbuses; + +foreach my $span (Zaptel::spans()) { + my $spanno = $span->num; + my $xpd = $span->xpd; + my @lines; + my $index = 0; + + @lines = @{$xpd->lines} if defined $xpd; + printf "### Span %2d: %s %s\n", $span->num, $span->name, $span->description; + foreach my $chan ($span->chans()) { + my %type_map = ( + OUT => 'Output', + IN => 'Input' + ); + my ($type) = map { $type_map{$_} or $_ } $chan->type || ("unknown"); + my $batt = ""; + $batt = "(battery)" if $chan->battery; + printf "%3d %-10s %-10s %s %s\n", + $chan->num, $type, $chan->signalling, $chan->info, $batt; + $index++; + } +} + +__END__ + +=head1 NAME + +lszaptel - List all zaptel channels with their types and spans. + +=head1 SYNOPSIS + +lszaptel + +=head1 DESCRIPTION + +Example output: + + ### Span 1: WCTDM/0 "Wildcard TDM400P REV E/F Board 1" + 1 FXO FXOLS (In use) + 2 FXS FXSKS + 3 FXS FXSKS + 4 FXS FXSKS + ### Span 2: XBUS-00/XPD-00 "Xorcom XPD #00/00: FXO" + 5 FXO FXSKS (In use) + 6 FXO FXSKS (In use) (no pcm) + 7 FXO FXSKS (In use) (no pcm) + 8 FXO FXSKS (In use) (no pcm) + 9 FXO FXSKS (In use) (no pcm) + 10 FXO FXSKS (In use) (no pcm) + 11 FXO FXSKS (In use) (no pcm) + 12 FXO FXSKS (In use) (no pcm) + ### Span 3: XBUS-00/XPD-10 "Xorcom XPD #00/10: FXO" + 13 FXO FXSKS (In use) (no pcm) + 14 FXO FXSKS (In use) (no pcm) + 15 FXO FXSKS (In use) (no pcm) + 16 FXO FXSKS (In use) (no pcm) + 17 FXO FXSKS (In use) (no pcm) + 18 FXO FXSKS (In use) (no pcm) + 19 FXO FXSKS (In use) (no pcm) + 20 FXO FXSKS (In use) (no pcm) + + ... + + ### Span 6: XBUS-01/XPD-00 "Xorcom XPD #01/00: FXS" + 37 FXS FXOLS (In use) + 38 FXS FXOLS (In use) (no pcm) + 39 FXS FXOLS (In use) (no pcm) + 40 FXS FXOLS (In use) (no pcm) + 41 FXS FXOLS (In use) (no pcm) + 42 FXS FXOLS (In use) (no pcm) + 43 FXS FXOLS (In use) (no pcm) + 44 FXS FXOLS (In use) (no pcm) + 45 Output FXOLS (In use) (no pcm) + 46 Output FXOLS (In use) (no pcm) + 47 Input FXOLS (In use) (no pcm) + 48 Input FXOLS (In use) (no pcm) + 49 Input FXOLS (In use) (no pcm) + 50 Input FXOLS (In use) (no pcm) + +The first column is the type of the channel (port, for an analog device) +and the second one is the signalling (if set). + +=head1 FILES + +lszaptel is a somewhat glorified 'cat /proc/zaptel/*' . Unlike that +command, it sorts the spans with the proper order. It also formats the +output slightly differently. diff --git a/xpp/lszaptel b/xpp/lszaptel deleted file mode 100755 index a836d98..0000000 --- a/xpp/lszaptel +++ /dev/null @@ -1,108 +0,0 @@ -#! /usr/bin/perl -w -# -# 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 File::Basename; -BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } - -use Zaptel; -use Zaptel::Span; -use Zaptel::Xpp; -use Zaptel::Xpp::Xbus; -use Zaptel::Xpp::Xpd; - -my @xbuses = Zaptel::Xpp::xbuses("SORT_CONNECTOR"); -my @xpds = map { $_->xpds } @xbuses; - -foreach my $span (Zaptel::spans()) { - my $spanno = $span->num; - my $xpd = $span->xpd; - my @lines; - my $index = 0; - - @lines = @{$xpd->lines} if defined $xpd; - printf "### Span %2d: %s %s\n", $span->num, $span->name, $span->description; - foreach my $chan ($span->chans()) { - my %type_map = ( - OUT => 'Output', - IN => 'Input' - ); - my ($type) = map { $type_map{$_} or $_ } $chan->type || ("unknown"); - my $batt = ""; - $batt = "(battery)" if $chan->battery; - printf "%3d %-10s %-10s %s %s\n", - $chan->num, $type, $chan->signalling, $chan->info, $batt; - $index++; - } -} - -__END__ - -=head1 NAME - -lszaptel - List all zaptel channels with their types and spans. - -=head1 SYNOPSIS - -lszaptel - -=head1 DESCRIPTION - -Example output: - - ### Span 1: WCTDM/0 "Wildcard TDM400P REV E/F Board 1" - 1 FXO FXOLS (In use) - 2 FXS FXSKS - 3 FXS FXSKS - 4 FXS FXSKS - ### Span 2: XBUS-00/XPD-00 "Xorcom XPD #00/00: FXO" - 5 FXO FXSKS (In use) - 6 FXO FXSKS (In use) (no pcm) - 7 FXO FXSKS (In use) (no pcm) - 8 FXO FXSKS (In use) (no pcm) - 9 FXO FXSKS (In use) (no pcm) - 10 FXO FXSKS (In use) (no pcm) - 11 FXO FXSKS (In use) (no pcm) - 12 FXO FXSKS (In use) (no pcm) - ### Span 3: XBUS-00/XPD-10 "Xorcom XPD #00/10: FXO" - 13 FXO FXSKS (In use) (no pcm) - 14 FXO FXSKS (In use) (no pcm) - 15 FXO FXSKS (In use) (no pcm) - 16 FXO FXSKS (In use) (no pcm) - 17 FXO FXSKS (In use) (no pcm) - 18 FXO FXSKS (In use) (no pcm) - 19 FXO FXSKS (In use) (no pcm) - 20 FXO FXSKS (In use) (no pcm) - - ... - - ### Span 6: XBUS-01/XPD-00 "Xorcom XPD #01/00: FXS" - 37 FXS FXOLS (In use) - 38 FXS FXOLS (In use) (no pcm) - 39 FXS FXOLS (In use) (no pcm) - 40 FXS FXOLS (In use) (no pcm) - 41 FXS FXOLS (In use) (no pcm) - 42 FXS FXOLS (In use) (no pcm) - 43 FXS FXOLS (In use) (no pcm) - 44 FXS FXOLS (In use) (no pcm) - 45 Output FXOLS (In use) (no pcm) - 46 Output FXOLS (In use) (no pcm) - 47 Input FXOLS (In use) (no pcm) - 48 Input FXOLS (In use) (no pcm) - 49 Input FXOLS (In use) (no pcm) - 50 Input FXOLS (In use) (no pcm) - -The first column is the type of the channel (port, for an analog device) -and the second one is the signalling (if set). - -=head1 FILES - -lszaptel is a somewhat glorified 'cat /proc/zaptel/*' . Unlike that -command, it sorts the spans with the proper order. It also formats the -output slightly differently. diff --git a/xpp/perl_modules/Zaptel.pm b/xpp/perl_modules/Zaptel.pm new file mode 100644 index 0000000..ef36bae --- /dev/null +++ b/xpp/perl_modules/Zaptel.pm @@ -0,0 +1,68 @@ +package Zaptel; +# +# 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::Span; + +=head1 NAME + +Zaptel - Perl interface to Zaptel information + +This package allows access from Perl to information about Zaptel +hardware and loaded Zaptel devices. + +=head1 SYNOPSIS + + # Listing channels in analog spans: + use Zaptel; + # scans system: + my @xbuses = Zaptel::spans(); + for my $span (@spans) { + next if ($span->is_digital); + $span->num. " - [". $span->type ."] ". $span->name. "\n"; + for my $chan ($span->chans) { + print " - ".$chan->num . " - [". $chan->type. "] ". $chan->fqn". \n"; + } + } +=cut + +my $proc_base = "/proc/dahdi"; + +=head1 spans() + +Returns a list of span objects, ordered by span number. + +=cut + +sub spans() { + my @spans; + + -d $proc_base or return (); + foreach my $zfile (glob "$proc_base/*") { + $zfile =~ s:$proc_base/::; + my $span = Zaptel::Span->new($zfile); + push(@spans, $span); + } + @spans = sort { $a->num <=> $b->num } @spans; + return @spans; +} + +=head1 SEE ALSO + +Span objects: L. + +Zaptel channels objects: L. + +Zaptel hardware devices information: L. + +Xorcom Astribank -specific information: L. + +=cut + +1; diff --git a/xpp/perl_modules/Zaptel/Chans.pm b/xpp/perl_modules/Zaptel/Chans.pm new file mode 100644 index 0000000..6f83f77 --- /dev/null +++ b/xpp/perl_modules/Zaptel/Chans.pm @@ -0,0 +1,202 @@ +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/perl_modules/Zaptel/Config/Defaults.pm b/xpp/perl_modules/Zaptel/Config/Defaults.pm new file mode 100644 index 0000000..360ca0a --- /dev/null +++ b/xpp/perl_modules/Zaptel/Config/Defaults.pm @@ -0,0 +1,56 @@ +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/perl_modules/Zaptel/Hardware.pm b/xpp/perl_modules/Zaptel/Hardware.pm new file mode 100644 index 0000000..ff7aeea --- /dev/null +++ b/xpp/perl_modules/Zaptel/Hardware.pm @@ -0,0 +1,168 @@ +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/perl_modules/Zaptel/Hardware/PCI.pm b/xpp/perl_modules/Zaptel/Hardware/PCI.pm new file mode 100644 index 0000000..a63b09f --- /dev/null +++ b/xpp/perl_modules/Zaptel/Hardware/PCI.pm @@ -0,0 +1,208 @@ +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/perl_modules/Zaptel/Hardware/USB.pm b/xpp/perl_modules/Zaptel/Hardware/USB.pm new file mode 100644 index 0000000..a2dc08f --- /dev/null +++ b/xpp/perl_modules/Zaptel/Hardware/USB.pm @@ -0,0 +1,116 @@ +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/perl_modules/Zaptel/Span.pm b/xpp/perl_modules/Zaptel/Span.pm new file mode 100644 index 0000000..9aceb78 --- /dev/null +++ b/xpp/perl_modules/Zaptel/Span.pm @@ -0,0 +1,300 @@ +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/perl_modules/Zaptel/Utils.pm b/xpp/perl_modules/Zaptel/Utils.pm new file mode 100644 index 0000000..8d13ad7 --- /dev/null +++ b/xpp/perl_modules/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/perl_modules/Zaptel/Xpp.pm b/xpp/perl_modules/Zaptel/Xpp.pm new file mode 100644 index 0000000..8b7458f --- /dev/null +++ b/xpp/perl_modules/Zaptel/Xpp.pm @@ -0,0 +1,199 @@ +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/perl_modules/Zaptel/Xpp/Line.pm b/xpp/perl_modules/Zaptel/Xpp/Line.pm new file mode 100644 index 0000000..2472c3b --- /dev/null +++ b/xpp/perl_modules/Zaptel/Xpp/Line.pm @@ -0,0 +1,95 @@ +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/perl_modules/Zaptel/Xpp/Xbus.pm b/xpp/perl_modules/Zaptel/Xpp/Xbus.pm new file mode 100644 index 0000000..e840f14 --- /dev/null +++ b/xpp/perl_modules/Zaptel/Xpp/Xbus.pm @@ -0,0 +1,118 @@ +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/perl_modules/Zaptel/Xpp/Xpd.pm b/xpp/perl_modules/Zaptel/Xpp/Xpd.pm new file mode 100644 index 0000000..5087f1f --- /dev/null +++ b/xpp/perl_modules/Zaptel/Xpp/Xpd.pm @@ -0,0 +1,123 @@ +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; diff --git a/xpp/zapconf b/xpp/zapconf deleted file mode 100755 index 7f94f6b..0000000 --- a/xpp/zapconf +++ /dev/null @@ -1,603 +0,0 @@ -#! /usr/bin/perl -w -# -# 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 File::Basename; -BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } - -use Zaptel; -use Zaptel::Xpp; -use Zaptel::Config::Defaults; - -my %default_context = ( - FXO => 'from-pstn', - FXS => 'from-internal', - IN => 'astbank-input', - OUT => 'astbank-output', - BRI_TE => 'from-pstn', - BRI_NT => 'from-internal', - E1_TE => 'from-pstn', - T1_TE => 'from-pstn', - J1_TE => 'from-pstn', - E1_NT => 'from-internal', - T1_NT => 'from-internal', - J1_NT => 'from-internal', - ); - -my %default_group = ( - FXO => 0, - FXS => "5", - IN => '', - OUT => '', - BRI_TE => 0, - BRI_NT => 6, - E1_TE => 0, - T1_TE => 0, - J1_TE => 0, - E1_NT => 6, - T1_NT => 6, - J1_NT => 6, - ); - -my $fxs_default_start = 'ls'; - -my %default_zaptel_signalling = ( - FXO => 'fxsks', - FXS => "fxo{fxs_default_start}", - IN => "fxo{fxs_default_start}", - OUT => "fxo{fxs_default_start}", - ); - -my %default_zapata_signalling = ( - FXO => 'fxs_ks', - FXS => "fxo_{fxs_default_start}", - IN => "fxo_{fxs_default_start}", - OUT => "fxo_{fxs_default_start}", - ); - -my $base_exten = 4000; -my $fxs_immediate = 'no'; -my $lc_country = 'us'; -my $loadzone = $lc_country; -my $defaultzone = $lc_country; -my $bri_sig_style = 'bri_ptmp'; -my $brint_overlap = 'no'; - -my %zaptel_default_vars = ( - base_exten => \$base_exten, - fxs_immediate => \$fxs_immediate, - fxs_default_start => \$fxs_default_start, - lc_country => [ - \$loadzone, - \$defaultzone, - ], - context_lines => \$default_context{FXO}, - context_phones => \$default_context{FXS}, - context_input => \$default_context{IN}, - context_output => \$default_context{OUT}, - group_phones => [ - \$default_group{FXS}, - \$default_group{IN}, - \$default_group{OUT}, - ], - group_lines => \$default_group{FXO}, - ZAPBRI_SIGNALLING => \$bri_sig_style, - brint_overlap => \$brint_overlap, - ); - -sub map_zaptel_defaults { - my %defaults = @_; - foreach my $name (keys %defaults) { - my $val = $defaults{$name}; - my $ref = $zaptel_default_vars{$name}; - my $type = ref $ref; - my @vars = (); - # Some broken shells (msh) export even variables - # That where not defined. Work around that. - next unless defined $val && $val ne ''; - if($type eq 'SCALAR') { - @vars = ($ref); - } elsif($type eq 'ARRAY') { - @vars = @$ref; - } else { - die "$0: Don't know how to map '$name' (type=$type)\n"; - } - foreach my $v (@vars) { - $$v = $val; - } - } -} - - -my $zapconf_file; -my $zapatachannels_file; -my $users_file; -my $zapataconf_file; - -my %files = ( - zaptel => { file => \$zapconf_file, func => \&gen_zaptelconf }, - zapata => { file => \$zapatachannels_file, func => \&gen_zapatachannelsconf }, - users => { file => \$users_file, func => \&gen_usersconf }, - zapataconf => { file => \$zapataconf_file, func => \&gen_zapataconf }, -); - -my @default_files = ("zaptel", "zapata"); - -my @spans = Zaptel::spans(); - -sub bchan_range($) { - my $span = shift || die; - my $first_chan = ($span->chans())[0]; - my $first_num = $first_chan->num(); - my $range_start = $first_num; - my @range; - my $prev = undef; - - die unless $span->is_digital(); - foreach my $c (@{$span->bchan_list()}) { - my $curr = $c + $first_num; - if(!defined($prev)) { - $prev = $curr; - } elsif($curr != $prev + 1) { - push(@range, sprintf("%d-%d", $range_start, $prev)); - $range_start = $curr; - } - $prev = $curr; - } - if($prev >= $first_num) { - push(@range, sprintf("%d-%d", $range_start, $prev)); - } - return join(',', @range); -} - -sub gen_zaptel_signalling($) { - my $chan = shift || die; - my $type = $chan->type; - my $num = $chan->num; - - die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital(); - if($type eq 'EMPTY') { - printf "# channel %d, %s, no module.\n", $num, $chan->fqn; - return; - } - my $sig = $default_zaptel_signalling{$type} || die "unknown default zaptel signalling for chan $chan type $type"; - if ($type eq 'IN') { - printf "# astbanktype: input\n"; - } elsif ($type eq 'OUT') { - printf "# astbanktype: output\n"; - } - printf "$sig=$num\n"; -} - -my $bri_te_last_timing = 1; - -sub gen_zaptel_digital($) { - my $span = shift || die; - my $num = $span->num() || die; - die "Span #$num is analog" unless $span->is_digital(); - my $termtype = $span->termtype() || die "$0: Span #$num -- unkown termtype [NT/TE]\n"; - my $timing; - my $lbo = 0; - my $framing = $span->framing() || die "$0: No framing information for span #$num\n"; - my $coding = $span->coding() || die "$0: No coding information for span #$num\n"; - my $span_crc4 = $span->crc4(); - $span_crc4 = (defined $span_crc4) ? ",$span_crc4" : ''; - my $span_yellow = $span->yellow(); - $span_yellow = (defined $span_yellow) ? ",$span_yellow" : ''; - - $timing = ($termtype eq 'NT') ? 0 : $bri_te_last_timing++; - printf "span=%d,%d,%d,%s,%s%s%s\n", - $num, - $timing, - $lbo, - $framing, - $coding, - $span_crc4, - $span_yellow; - printf "# termtype: %s\n", lc($termtype); - printf "bchan=%s\n", bchan_range($span); - my $dchan = $span->dchan(); - printf "dchan=%d\n", $dchan->num(); -} - -sub gen_zaptelconf($) { - my $file = shift || die; - rename "$file", "$file.bak" - or $! == 2 # ENOENT (No dependency on Errno.pm) - or die "Failed to backup old config: $!\n"; - open(F, ">$file") || die "$0: Failed to open $file: $!\n"; - my $old = select F; - printf "# Autogenerated by %s on %s -- do not hand edit\n", $0, scalar(localtime); - print <<"HEAD"; -# Zaptel Configuration File -# -# This file is parsed by the Zaptel Configurator, ztcfg -# -HEAD - foreach my $span (@spans) { - printf "# Span %d: %s %s\n", $span->num, $span->name, $span->description; - if($span->is_digital()) { - gen_zaptel_digital($span); - } else { - foreach my $chan ($span->chans()) { - if(1 || !defined $chan->type) { - my $type = $chan->probe_type; - my $num = $chan->num; - die "Failed probing type for channel $num" - unless defined $type; - $chan->type($type); - } - gen_zaptel_signalling($chan); - } - } - print "\n"; - } - print <<"TAIL"; -# Global data - -loadzone = $loadzone -defaultzone = $defaultzone -TAIL - close F; - select $old; -} - -my %DefaultConfigs = ( - context => 'default', - group => '63', # FIXME: should not be needed. - overlapdial => 'no', - busydetect => 'no', - rxgain => 0, - txgain => 0, -); - -sub reset_zapata_values { - foreach my $arg (@_) { - if (exists $DefaultConfigs{$arg}) { - print "$arg = $DefaultConfigs{$arg}\n"; - } else { - print "$arg =\n"; - } - } -} - -sub gen_zapata_digital($) { - my $span = shift || die; - my $num = $span->num() || die; - die "Span #$num is analog" unless $span->is_digital(); - my $type = $span->type() || die "$0: Span #$num -- unkown type\n"; - my $termtype = $span->termtype() || die "$0: Span #$num -- unkown termtype [NT/TE]\n"; - my $group = $default_group{"$type"}; - my $context = $default_context{"$type"}; - my @to_reset = qw/context group/; - - die "$0: missing default group (termtype=$termtype)\n" unless defined($group); - die "$0: missing default context\n" unless $context; - - my $sig = $span->signalling || die "missing signalling info for span #$num type $type"; - grep($bri_sig_style eq $_, 'bri', 'bri_ptmp', 'pri') or die "unknown signalling style for BRI"; - if($span->is_bri() and $bri_sig_style eq 'bri_ptmp') { - $sig .= '_ptmp'; - } - if ($span->is_bri() && $termtype eq 'NT' && $brint_overlap eq 'yes') { - print "overlapdial = yes\n"; - push(@to_reset, qw/overlapdial/); - } - - $group .= "," . (10 + $num); # Invent unique group per span - printf "group=$group\n"; - printf "context=$context\n"; - printf "switchtype = %s\n", $span->switchtype; - printf "signalling = %s\n", $sig; - printf "channel => %s\n", bchan_range($span); - reset_zapata_values(@to_reset); -} - -sub gen_zapata_channel($) { - my $chan = shift || die; - my $type = $chan->type; - my $num = $chan->num; - die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital(); - my $exten = $base_exten + $num; - my $sig = $default_zapata_signalling{$type}; - my $context = $default_context{$type}; - my $group = $default_group{$type}; - my $callerid; - my $immediate; - - return if $type eq 'EMPTY'; - die "missing default_zapata_signalling for chan #$num type $type" unless $sig; - $callerid = ($type eq 'FXO') - ? 'asreceived' - : sprintf "\"Channel %d\" <%04d>", $num, $exten; - if($type eq 'IN') { - $immediate = 'yes'; - } - # FIXME: $immediage should not be set for 'OUT' channels, but meanwhile - # it's better to be compatible with genzaptelconf - $immediate = 'yes' if $fxs_immediate eq 'yes' and $sig =~ /^fxo_/; - my $signalling = $chan->signalling; - $signalling = " " . $signalling if $signalling; - my $info = $chan->info; - $info = " " . $info if $info; - printf ";;; line=\"%d %s%s%s\"\n", $num, $chan->fqn, $signalling, $info; - printf "signalling=$sig\n"; - printf "callerid=$callerid\n"; - printf "mailbox=%04d\n", $exten unless $type eq 'FXO'; - if(defined $group) { - printf "group=$group\n"; - } - printf "context=$context\n"; - printf "immediate=$immediate\n" if defined $immediate; - printf "channel => %d\n", $num; - # Reset following values to default - printf "callerid=\n"; - printf "mailbox=\n" unless $type eq 'FXO'; - if(defined $group) { - printf "group=\n"; - } - printf "context=default\n"; - printf "immediate=no\n" if defined $immediate; - print "\n"; -} - -sub gen_zapatachannelsconf($) { - my $file = shift || die; - rename "$file", "$file.bak" - or $! == 2 # ENOENT (No dependency on Errno.pm) - or die "Failed to backup old config: $!\n"; - open(F, ">$file") || die "$0: Failed to open $file: $!\n"; - my $old = select F; - printf "; Autogenerated by %s on %s -- do not hand edit\n", $0, scalar(localtime); - print <<"HEAD"; -; Zaptel Channels Configurations (zapata.conf) -; -; This is not intended to be a complete zapata.conf. Rather, it is intended -; to be #include-d by /etc/zapata.conf that will include the global settings -; - -HEAD - foreach my $span (@spans) { - printf "; Span %d: %s %s\n", $span->num, $span->name, $span->description; - if($span->is_digital()) { - gen_zapata_digital($span); - } else { - foreach my $chan ($span->chans()) { - gen_zapata_channel($chan); - } - } - print "\n"; - } - close F; - select $old; -} - -sub gen_users_channel($) { - my $chan = shift || die; - my $type = $chan->type; - my $num = $chan->num; - die "channel $num type $type is not an analog channel\n" if $chan->span->is_digital(); - my $exten = $base_exten + $num; - my $sig = $default_zapata_signalling{$type}; - my $full_name = "$type $num"; - - die "missing default_zapata_signalling for chan #$num type $type" unless $sig; - print << "EOF"; -[$exten] -callwaiting = yes -context = numberplan-custom-1 -fullname = $full_name -cid_number = $exten -hasagent = no -hasdirectory = no -hasiax = no -hasmanager = no -hassip = no -hasvoicemail = yes -host = dynamic -mailbox = $exten -threewaycalling = yes -vmsecret = 1234 -secret = 1234 -signalling = $sig -zapchan = $num -registeriax = no -registersip = no -canreinvite = no -nat = no -dtmfmode = rfc2833 -disallow = all -allow = all - -EOF -} - -# generate users.conf . The specific users.conf is strictly oriented -# towards using with the asterisk-gui . -# -# This code could have generated a much simpler and smaller -# configuration file, had there been minimal level of support for -# configuration templates in the asterisk configuration rewriting. Right -# now Asterisk's configuration rewriting simply freaks out in the face -# of templates: http://bugs.digium.com/11442 . -sub gen_usersconf($) { - my $file = shift || die; - rename "$file", "$file.bak" - or $! == 2 # ENOENT (No dependency on Errno.pm) - or die "Failed to backup old config: $!\n"; - open(F, ">$file") || die "$0: Failed to open $file: $!\n"; - my $old = select F; - print <<"HEAD"; -;! -;! Automatically generated configuration file -;! Filename: @{[basename($file)]} ($file) -;! Generator: $0 -;! Creation Date: @{[scalar(localtime)]} -;! -[general] -; -; Full name of a user -; -fullname = New User -; -; Starting point of allocation of extensions -; -userbase = @{[$base_exten+1]} -; -; Create voicemail mailbox and use use macro-stdexten -; -hasvoicemail = yes -; -; Set voicemail mailbox @{[$base_exten+1]} password to 1234 -; -vmsecret = 1234 -; -; Create SIP Peer -; -hassip = no -; -; Create IAX friend -; -hasiax = no -; -; Create Agent friend -; -hasagent = no -; -; Create H.323 friend -; -;hash323 = yes -; -; Create manager entry -; -hasmanager = no -; -; Remaining options are not specific to users.conf entries but are general. -; -callwaiting = yes -threewaycalling = yes -callwaitingcallerid = yes -transfer = yes -canpark = yes -cancallforward = yes -callreturn = yes -callgroup = 1 -pickupgroup = 1 -localextenlength = @{[length($base_exten)]} - - -HEAD - foreach my $span (@spans) { - next unless grep { $_ eq $span->type} ( 'FXS', 'IN', 'OUT' ); - printf "; Span %d: %s %s\n", $span->num, $span->name, $span->description; - foreach my $chan ($span->chans()) { - gen_users_channel($chan); - } - print "\n"; - } - close F; - select $old; -} - -sub gen_zapataconf($) { - my $file = shift || die; - open(F, ">>$file") || die "$0: Failed to open $file: $!\n"; - my $old = select F; - foreach my $span (@spans) { - next unless $span->type eq 'FXO'; - my $current_sig = ""; - for my $chan ($span->chans()) { - my $chan_num = $chan->num; - if ($default_zapata_signalling{$chan->type} ne $current_sig) { - $current_sig = $default_zapata_signalling{$chan->type}; - print "\nsignalling = $current_sig"; - print "\nchannel => $chan_num"; - } else { - print ",$chan_num"; - } - } - print "\n"; - } - close F; - select $old; -} - -sub set_defaults { - # Source default files - my ($default_file, %source_defaults) = - Zaptel::Config::Defaults::source_vars(keys(%zaptel_default_vars)); - map_zaptel_defaults(%source_defaults); - # Fixups - foreach my $val (values %default_zaptel_signalling, values %default_zapata_signalling) { - $val =~ s/{fxs_default_start}/$fxs_default_start/g; - } - $zapconf_file = $ENV{ZAPCONF_FILE} || "/etc/zaptel.conf"; - $zapatachannels_file = $ENV{ZAPATA_FILE} || "/etc/asterisk/zapata-channels.conf"; - $users_file = $ENV{USERS_FILE} || "/etc/asterisk/users.conf"; - $zapataconf_file = $ENV{ZAPATACONF_FILE} || "/etc/asterisk/zapata.conf"; -} - -sub parse_args { - return if @ARGV == 0; - @default_files = (); - for my $file (@ARGV) { - die "$0: Unknown file '$file'" unless defined $files{$file}; - push @default_files, $file; - } -} - -sub generate_files { - for my $file (@default_files) { - &{$files{$file}->{func}}(${$files{$file}->{file}}); - } -} -set_defaults; -parse_args; -generate_files; - -__END__ - -=head1 NAME - -zapconf - Generate configuration for zaptel channels. - -=head1 SYNOPSIS - -zapconf [FILES...] - -=head1 DESCRIPTION - -This script generate configuration files for Zaptel hardware. -Currently it can generate three files: zaptel, zapata, users and zapataconf (see below). -Without arguments, it generates only zaptel and zapata. - -=over 4 - -=item zaptel - /etc/zaptel.conf - -Configuration for ztcfg(1). It's location may be overriden by the -environment variable ZAPCONF_FILE. - -=item zapata - /etc/asterisk/zapata-channels.conf - -Configuration for asterisk(1). It should be included in the main /etc/asterisk/zapata.conf. -It's location may be overriden by the environment variable ZAPATA_FILE. - -=item users - /etc/asterisk/users.conf - -Configuration for asterisk(1) and AsteriskGUI. -It's location may be overriden by the environment variable USERS_FILE. - -=item zapataconf - /etc/asterisk/zapata.conf - -Configuration for asterisk(1) and AsteriskGUI. -It's location may be overriden by the environment variable ZAPATACONF_FILE. - - -=back diff --git a/xpp/zaptel-helper b/xpp/zaptel-helper deleted file mode 100644 index 1b2ca45..0000000 --- a/xpp/zaptel-helper +++ /dev/null @@ -1,401 +0,0 @@ -#!/bin/sh - -# zaptel-helper: helper script/functions for Zaptel - -# Wrriten by Tzafrir Cohen -# Copyright (C) 2006-2007, Xorcom -# -# All rights reserved. -# -# This program is free software; you can redistribute it and/or modify -# it under the terms of the GNU General Public License as published by -# the Free Software Foundation; either version 2 of the License, or -# (at your option) any later version. -# -# This program is distributed in the hope that it will be useful, -# but WITHOUT ANY WARRANTY; without even the implied warranty of -# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -# GNU General Public License for more details. -# -# You should have received a copy of the GNU General Public License -# along with this program; if not, write to the Free Software -# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - -# Should be possible to run with -e set. This is also recommended. - -# Constants: -# maximal time (in seconds) to wait for /dev/zap/dtl to appear after -# loading zaptel -DEVZAP_TIMEOUT=${DEVZAP_TIMEOUT:-20} - -# Zaptel modules we'll try when detecting zaptel hardware: -ALL_MODULES="${ALL_MODULES:-zaphfc qozap ztgsm wctdm wctdm24xxp wcfxo wcfxs pciradio tor2 torisa wct1xxp wct4xxp wcte11xp wanpipe wcusb xpp_usb}" - -# Where do we write the list of modules we detected (if at all): -MODLIST_FILE_DEBIAN=${MODLIST_FILE_DEBIAN:-/etc/modules} -MODLIST_FILE_REDHAT=${MODLIST_FILE_REDHAT:-/etc/sysconfig/zaptel} - -# The location of of the fxotune binary -FXOTUNE="${FXOTUNE:-/usr/sbin/fxotune}" -FXOTUNE_CONF="${FXOTUNE_CONF:-/etc/fxotune.conf}" - -# this is the context FXO zaptel channels are in. -# See run_fxotune. -FXO_CONTEXT=${FXO_CONTEXT:-from-pstn} - -ZTCFG="${ZTCFG:-/sbin/ztcfg}" - -# TODO: this may not be appropriate for a general-purpose script. -# However you should not use a direct 'echo' to write output to the user -#, to make it simple to override. -say() { - echo "$@" -} - -error() { - echo >&2 "$@" -} - -die() { - error "$@" - exit 1 -} - - -############################################################################# -##### -##### Init helper functions -##### - - -# Wait for udev to generate /dev/zap/ctl, if needed: -wait_for_zapctl() { - # if device file already exists, or if zaptel has failed to load: - # no point waiting. - if [ -c /dev/zap/ctl ] || ! grep -q zaptel /proc/modules ; then - return - fi - - say "Waiting for /dev/zap/ctl to be generated" - devzap_found=0 - for i in `seq $DEVZAP_TIMEOUT`; do - sleep 1 - if [ -c /dev/zap/ctl ]; then - devzap_found=1 - break - fi - done - if [ "$devzap_found" != 1 ]; then - say "Still no /dev/zap/ctl after $devzap_timeout seconds." - error "No /dev/zap/ctl: cannot run ztcfg. Aborting." - fi -} - -# load the fxotune parameters -# FIXME: /etc/fxotune.conf is a bad location for that file . -# /etc/zaptel/fxotune.conf? -fxotune_load() { - if [ -x "$FXOTUNE" ] && [ -r "FXOTUNE_CONF" ]; then - $FROTUNE -s - fi -} - -# If there is no zaptel timing source, load -# ztdummy. Other modules should have been loaded by -# now. -guarantee_timing_source() { - if ! head -c 0 /dev/zap/pseudo 2>/dev/null - then modprobe ztdummy || true # will fail if there is no module package - fi -} - -kill_zaptel_users() { - fuser -k /dev/zap/* -} - -# recursively unload a module and its dependencies, if possible. -# where's modprobe -r when you need it? -# inputs: module to unload. -# returns: the result from -unload_module() { - module="$1" - line=`lsmod 2>/dev/null | grep "^$1 "` - if [ "$line" = '' ]; then return; fi # module was not loaded - - set -- $line - # $1: the original module, $2: size, $3: refcount, $4: deps list - mods=`echo $4 | tr , ' '` - for mod in $mods; do - # run in a subshell, so it won't step over our vars: - (unload_module $mod) - # TODO: the following is probably the error handling we want: - # if [ $? != 0 ]; then return 1; fi - done - rmmod $module -} - -# sleep a while until the xpp modules fully register -wait_for_xpp() { - if [ -d /proc/xpp ] - then - # wait for the XPDs to register: - # TODO: improve error reporting and produce a messagee here - cat /proc/xpp/XBUS-*/waitfor_xpds 2>/dev/null >/dev/null || true - fi -} - -zap_reg_xpp() { - if [ ! -d /proc/xpp ]; then return; fi - - # Get a list of connected Astribank devices, sorted by the name of - # the USB connector. That order is rather arbitrary, but will not - # change without changes to the cabling. - xbusses=`sort -k 2 /proc/xpp/xbuses | awk -F: '/STATUS=connected/ {print $1}'` - - # get a list of XPDs that were not yet registered as zaptel spans. - # this will be the case if you set the parameter zap_autoreg=0 to - # the module xpp - # Append /dev/null to provide a valid file name in case of an empty pattern. - xbusses_pattern=`echo $xbusses| sed -e 's|XBUS-[0-9]*|/proc/xpp/&/XPD-*/zt_registration|g'`' /dev/null' - xpds_to_register=`grep -l 0 $xbusses_pattern 2>/dev/null` || true - for file in $xpds_to_register; do - echo 1 >$file - done -} - -# Set the sync source of the Astribank to the right value -fix_asterisbank_sync() { - # do nothing if module not present - if [ ! -d /proc/xpp ]; then return; fi - - #if ! grep -q '^HOST' /proc/xpp/sync 2>/dev/null; then return; fi - - case "$XPP_SYNC" in - n*|N*) return;; - host|HOST) sync_value="HOST";; - [0-9]*)sync_value="$XPP_SYNC";; - *) - # find the number of the first bus, and sync from it: - fxo_pat=`awk -F: '/STATUS=connected/{print $1}' /proc/xpp/xbuses | sed -e 's|.*|/proc/xpp/&/*/fxo_info|'` - # find the first FXO unit, and set it as the sync master - bus=`ls -1 $fxo_pat 2> /dev/null | head -n1 | cut -d- -f2 | cut -d/ -f1` - - # do nothing if there is no bus: - case "$bus" in [0-9]*):;; *) return;; esac - sync_value="$bus 0" - ;; - esac - # the built-in echo of bash fails to print a proper error on failure - if ! /bin/echo "$sync_value" >/proc/xpp/sync - then - error "Updating XPP sync source failed (used XPP_SYNC='$XPP_SYNC')" - fi -} - -run_adj_clock() { - if [ "$XPP_RUN_ADJ_CLOCK" = '' ]; then return; fi - - # daemonize adj_clock: - (adj_clock /dev/null 2>&1 &)& -} - -init_astribank() { - wait_for_xpp - zap_reg_xpp - fix_asterisbank_sync - run_adj_clock -} - -xpp_do_blink() { - val="$1" - shift - for xbus in $* - do - for xpd in /proc/xpp/XBUS-"$xbus"/XPD-* - do - echo "$val" > "$xpd/blink" - done - done -} - -xpp_blink() { - xbuses=`grep STATUS=connected /proc/xpp/xbuses | sed -e 's/^XBUS-//' -e 's/:.*$//'` - num=`echo $1 | tr -c -d 0-9` - case "$num" in - [0-9]*) - shift - xpp_do_blink 1 $xbuses - sleep 2 - xpp_do_blink 0 $xbuses - ;; - *) - shift - echo 1>&2 Enumerating $xbuses - xpp_do_blink 0 $xbuses - for i in $xbuses - do - echo "BLINKING: $i" - xpp_do_blink 1 "$i" - sleep 2 - xpp_do_blink 0 "$i" - done - ;; - esac -} - -# The current Debian start function. -# The function is not responsible for loading the zaptel modules: -# they will be loaded beforehand. -debian_start() { - wait_for_xpp - zap_reg_xpp - fix_asterisbank_sync - wait_for_zapctl - - if [ -r /etc/fxotune.conf ] && [ -x $FXOTUNE ]; then - $FXOTUNE -s - fi - - # configure existing modules: - $ZTCFG -} - - -# run_fxotune: destroy all FXO channels and run fxotune. -# This allows running fxotune without completly shutting down Asterisk. -# -# A simplistic assumption: every zaptel channel in the context from-pstn -# is a FXO ones. -# or rather: all tunable FXO channels are in the context from-pstn are -# not defined by zaptel. -run_fxotune() { - zap_fxo_chans=`asterisk -rx "zap show channels" | awk "/$FXO_CONTEXT/{print \$1}"` - xpp_fxo_chans=`cat /proc/zaptel/* | awk '/XPP_FXO/{print $1}'` - for chan in $xpp_fxo_chans $zap_fxo_chans; do - asterisk -rx "zap destroy channel $chan" - done - $FXOTUNE -i - asterisk -rx "zap restart" -} - - -# recursively unload a module and its dependencies, if possible. -# where's modprobe -r when you need it? -# inputs: module to unload. -unload_module() { - set +e - module="$1" - line=`lsmod 2>/dev/null | grep "^$module "` - if [ "$line" = '' ]; then return; fi # module was not loaded - - set -- $line - # $1: the original module, $2: size, $3: refcount, $4: deps list - mods=`echo $4 | tr , ' '` - # xpd_fxs actually sort of depends on xpp: - case "$module" in xpd_*) mods="xpp_usb $mods";; esac - for mod in $mods; do - # run in a subshell, so it won't step over our vars: - (unload_module $mod) - done - rmmod $module || true - set -e -} - -unload() { - unload_module zaptel -} - -# sleep a while until the xpp modules fully register -wait_for_xpp() { - if [ -d /proc/xpp ] && \ - [ "`cat /sys/module/xpp/parameters/zap_autoreg`" = 'Y' ] - then - # wait for the XPDs to register: - # TODO: improve error reporting and produce a messagee here - cat /proc/xpp/XBUS-*/waitfor_xpds 2>/dev/null >/dev/null || true - fi -} - -############################################################################# -##### -##### Hardware detection functions -##### - -load_modules() { - say "Test Loading modules:" - for i in $ALL_MODULES - do - lines_before=`count_proc_zap_lines` - args="${i}_args" - eval "args=\$$args" - # a module is worth listing if it: - # a. loaded successfully, and - # b. added channels lines under /proc/zaptel/* - if /sbin/modprobe $i $args 2> /dev/null - then - check=0 - case "$i" in - xpp_usb) check=`grep 'STATUS=connected' 2>/dev/null /proc/xpp/xbuses | wc -l` ;; - # FIXME: zttranscode will always load, and will never - # add a span. Maybe try to read from /dev/zap/transcode . - zttranscode) : ;; - *) if [ $lines_before -lt `count_proc_zap_lines` ]; then check=1; fi ;; - esac - if [ "$check" != 0 ] - then - probed_modules="$probed_modules $i" - say " ok $i $args" - else - say " - $i $args" - rmmod $i - fi - else - say " - $i $args" - fi - done -} - -update_module_list_debian() { - say "Updating Debian modules list $MODLIST_FILE_DEBIAN." - del_args=`for i in $ALL_MODULES ztdummy - do - echo "$i" | sed s:.\*:-e\ '/^&/d': - done` - add_args=`for i in $* - do - echo "$i" | sed s:.\*:-e\ '\$a&': - done` - - sed -i.bak $del_args "$MODLIST_FILE_DEBIAN" - for i in $* - do - echo "$i" - done >> "$MODLIST_FILE_DEBIAN" -} - -update_module_list_redhat() { - say "Updating modules list in zaptel init config $MODLIST_FILE_REDHAT." - sed -i.bak -e '/^MODULES=/d' "$MODLIST_FILE_REDHAT" - echo "MODULES=\"$*\"" >> "$MODLIST_FILE_REDHAT" -} - -update_module_list() { - if [ -f "$MODLIST_FILE_DEBIAN" ]; then - update_module_list_debian "$@" - elif [ -f "$MODLIST_FILE_REDHAT" ]; then - update_module_list_redhat "$@" - else - die "Can't find a modules list to update. Tried: $MODLIST_FILE_DEBIAN, $MODLIST_FILE_REDHAT. Aborting" - fi -} - - - - - - -# unless we wanted to use this as a set of functions, run -# the given function with its parameters: -if [ "$ZAPHELPER_ONLY_INCLUDE" = '' ]; then - "$@" -fi diff --git a/xpp/zaptel_drivers b/xpp/zaptel_drivers deleted file mode 100755 index d7904c0..0000000 --- a/xpp/zaptel_drivers +++ /dev/null @@ -1,9 +0,0 @@ -#! /usr/bin/perl -w -use strict; -use File::Basename; -BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } - -use Zaptel::Hardware; - -my $hardware = Zaptel::Hardware->scan; -print join("\n", $hardware->drivers),"\n"; diff --git a/xpp/zaptel_hardware b/xpp/zaptel_hardware deleted file mode 100755 index 004a44b..0000000 --- a/xpp/zaptel_hardware +++ /dev/null @@ -1,164 +0,0 @@ -#! /usr/bin/perl -w -# -# 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 File::Basename; -use Getopt::Std; -BEGIN { my $dir = dirname($0); unshift(@INC, "$dir", "$dir/zconf"); } - -use Zaptel; -use Zaptel::Span; -use Zaptel::Xpp; -use Zaptel::Xpp::Xbus; -use Zaptel::Hardware; - -sub usage { - die "Usage: $0 [-v][-x]\n"; -} - -our ($opt_v, $opt_x); -getopts('vx') || usage; -@ARGV == 0 or usage; - -my $hardware = Zaptel::Hardware->scan; -my @spans = Zaptel::spans; - -sub show_xbus($) { - my $xbus = shift or die; - my @xpds = $xbus->xpds; - my $label = '[' . $xbus->label() . ']'; - my $connector = ($xbus->status eq 'CONNECTED') ? $xbus->connector : "MISSING"; - printf " LABEL=%-20s CONNECTOR=%-20s\n", $label, $connector; - foreach my $xpd (@xpds) { - my $reg = $xpd->zt_registration; - my $span; - my $spanstr; - if($reg && @spans) { - ($span) = grep { $_->name eq $xpd->fqn } @spans; - $spanstr = ($span) ? ("Span " . $span->num) : ""; - } else { - $spanstr = "Unregistered"; - } - my $master = ''; - #$master = "XPP-SYNC" if $xpd->is_sync_master; - $master .= " ZAPTEL-SYNC" if defined($span) && $span->is_zaptel_sync_master; - printf "\t%-10s: %-8s %s %s\n", $xpd->fqn, $xpd->type, $spanstr, $master; - } -} - -my %seen; -my $format = "%-20s %-12s %4s:%4s %s\n"; - -sub show_disconnected(%) { - my %seen = @_; - - my $notified_lost = 0; - foreach my $xbus (Zaptel::Xpp::xbuses('SORT_CONNECTOR')) { - if(!$seen{$xbus->name}) { - print "----------- XPP Spans with disconnected hardware -----------\n" - unless $notified_lost++; - printf($format, $xbus->name, '', '', '', "NO HARDWARE"); - show_xbus($xbus) if $opt_v; - } - } -} - -foreach my $dev ($hardware->device_list) { - my $driver = $dev->driver || ""; - my $xbus; - my $loaded; - if($dev->is_astribank) { - $xbus = $dev->xbus; - } - $loaded = $dev->loaded; - warn "driver should be '$driver' but is actually '$loaded'\n" - if defined($loaded) && $driver ne $loaded; - $driver = "$driver" . (($loaded) ? "+" : "-"); - my $description = $dev->description || ""; - printf $format, $dev->hardware_name, $driver, $dev->vendor, $dev->product, $description; - if(!defined $xbus || !$xbus) { - next; - } - $seen{$xbus->name} = 1; - show_xbus($xbus) if $opt_v; -} - -show_disconnected(%seen) if $opt_x; - -__END__ - -=head1 NAME - -zaptel_hardware - Shows Zaptel hardware devices. - -=head1 SYNOPSIS - -zaptel_hardware [-v][-x] - -=head1 OPTIONS - -=over - -=item -v - -Verbose ouput - show spans used by each device etc. Currently only -implemented for the Xorcom Astribank. - -=item -x - -Show disconnected Astribank unit, if any. - -=back - -=head1 DESCRIPTION - -Show all zaptel hardware devices. Devices are recognized according to -lists of PCI and USB IDs in Zaptel::Hardware::PCI.pm and -Zaptel::Hardware::USB.pm . For PCI it is possible to detect by -sub-vendor and sub-product ID as well. - -The first output column is the connector: a bus specific field that -shows where this device is. - -The second field shows which driver should handle the device. a "-" sign -marks that the device is not yet handled by this driver. A "+" sign -means that the device is handled by the driver. - -For the Xorcom Astribank (and in the future: for other Zaptel devices) -some further information is provided from the driver. Those extra lines -always begin with spaces. - -Example output: - -Without drivers loaded: - - usb:001/002 xpp_usb- e4e4:1152 Astribank-multi FPGA-firmware - usb:001/003 xpp_usb- e4e4:1152 Astribank-multi FPGA-firmware - pci:0000:01:0b.0 wctdm- e159:0001 Wildcard TDM400P REV H - -With drivers loaded, without -v: - usb:001/002 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware - usb:001/003 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware - pci:0000:01:0b.0 wctdm+ e159:0001 Wildcard TDM400P REV E/F - -With drivers loaded, with -v: - usb:001/002 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware - LABEL=[usb:123] CONNECTOR=usb-0000:00:1d.7-1 - XBUS-00/XPD-00: FXS Span 2 - XBUS-00/XPD-10: FXS Span 3 - XBUS-00/XPD-20: FXS Span 4 - XBUS-00/XPD-30: FXS Span 5 - usb:001/003 xpp_usb+ e4e4:1152 Astribank-multi FPGA-firmware - LABEL=[usb:4567] CONNECTOR=usb-0000:00:1d.7-4 - XBUS-01/XPD-00: FXS Span 6 XPP-SYNC - XBUS-01/XPD-10: FXO Span 7 - XBUS-01/XPD-20: FXO Span 8 - XBUS-01/XPD-30: FXO Span 9 - pci:0000:01:0b.0 wctdm+ e159:0001 Wildcard TDM400P REV E/F - diff --git a/xpp/zconf/Zaptel.pm b/xpp/zconf/Zaptel.pm deleted file mode 100644 index ef36bae..0000000 --- a/xpp/zconf/Zaptel.pm +++ /dev/null @@ -1,68 +0,0 @@ -package Zaptel; -# -# 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::Span; - -=head1 NAME - -Zaptel - Perl interface to Zaptel information - -This package allows access from Perl to information about Zaptel -hardware and loaded Zaptel devices. - -=head1 SYNOPSIS - - # Listing channels in analog spans: - use Zaptel; - # scans system: - my @xbuses = Zaptel::spans(); - for my $span (@spans) { - next if ($span->is_digital); - $span->num. " - [". $span->type ."] ". $span->name. "\n"; - for my $chan ($span->chans) { - print " - ".$chan->num . " - [". $chan->type. "] ". $chan->fqn". \n"; - } - } -=cut - -my $proc_base = "/proc/dahdi"; - -=head1 spans() - -Returns a list of span objects, ordered by span number. - -=cut - -sub spans() { - my @spans; - - -d $proc_base or return (); - foreach my $zfile (glob "$proc_base/*") { - $zfile =~ s:$proc_base/::; - my $span = Zaptel::Span->new($zfile); - push(@spans, $span); - } - @spans = sort { $a->num <=> $b->num } @spans; - return @spans; -} - -=head1 SEE ALSO - -Span objects: L. - -Zaptel channels objects: L. - -Zaptel hardware devices information: L. - -Xorcom Astribank -specific information: L. - -=cut - -1; 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