add cyclades

1 files changed, 263 insertions, 0 deletions

diff --git a/INF/Cyclades.pm b/INF/Cyclades.pm
new file mode 100644
index 0000000..6d6f207
--- /dev/null
+++ b/INF/Cyclades.pm
@@ -0,0 +1,263 @@
+#!/usr/bin/env perl
+
+package INF::Cyclades;
+
+use Net::Telnet;
+use Data::Dumper;
+
+sub flush($) {
+    my $self = shift;
+    $self->{telnet}->get( Timeout => 1, Errmode => 'return' );
+}
+
+sub get_until_timeout($) {
+    my $self = shift;
+    my $ret  = "";
+
+    my $red;
+
+    while (
+        defined(
+            $red = $self->{telnet}->get( Timeout => 1, Errmode => 'return' )
+        )
+      )
+    {
+        $ret .= $red;
+    }
+
+    return $ret;
+}
+
+sub get_until_match($$$$) {
+    my ( $self, $match, $echo, $tries ) = @_;
+    my $ret = "";
+
+    while ( --$tries ) {
+        my $data = $self->get_until_timeout;
+
+        print $data if $echo and defined $data;
+        $ret .= $data if defined $data;
+
+        if ( index( $ret, $match ) != -1 ) {
+            print "\n" if $echo;
+            return $ret;
+        }
+    }
+    print "\n" if $echo;
+    return undef;
+}
+
+sub sync($) {
+    my $self = shift;
+
+    my $tries = 7;
+
+    while ( --$tries ) {
+        my $data = $self->get_until_timeout;
+
+        if ( $data =~ /username:/i ) {
+            $self->{telnet}->print( $self->{username} );
+        }
+        elsif ( $data =~ /password:/i ) {
+            $self->{telnet}->print( $self->{password} );
+        }
+        elsif ( $data =~ /pm>/i ) {
+            last;
+        }
+        else {
+            $self->{telnet}->print("");
+        }
+    }
+
+    return 1 if $tries > 0;
+
+    return 0;
+}
+
+sub update_cache($$) {
+    my ( $self, $wot ) = @_;
+
+    #    return undef unless $self->sync;
+
+    $self->{telnet}->print( "status " . $wot );
+    my $data = $self->get_until_match( "pm>", 0, 3 );
+
+    my @lines = ( split /\n/, $data );
+
+    shift @lines;
+    shift @lines;
+
+    for my $line (@lines) {
+        chomp $line;
+        chomp $line;
+        my @fields = split /\t/, $line;
+
+        my $port = int( $fields[0] );
+        next unless $port > 0;
+
+        $fields[1] =~ s/^\s*//;
+        $fields[1] =~ s/\s*$//;
+
+        $self->{cache}->[$port] = { name => $fields[1], state => $fields[2] };
+    }
+}
+
+sub get_cache($) {
+    my $self = shift;
+    return if exists $self->{cache};
+
+    $self->update_cache("all");
+}
+
+sub name_get($) {
+    my $self = shift;
+    return $self->{host};
+}
+
+sub pdu_load_get($) {
+    my $self = shift;
+    my @ret  = ();
+
+    #    return undef unless $self->sync;
+
+    $self->{telnet}->print("current");
+    my $data = $self->get_until_match( "pm>", 0, 3 );
+
+    return undef unless $data =~ /True RMS current: ([.0-9]+)A\./i;
+    push @ret, $1;
+    push @ret, $1 if $data =~ /True RMS current for segment A: ([.0-9]+)A\./i;
+    push @ret, $1 if $data =~ /True RMS current for segment B: ([.0-9]+)A\./i;
+
+    return join( ',', @ret );
+}
+
+sub psu_status($) {
+    my $self = shift;
+    return undef;
+}
+
+sub port_count($) {
+    my $self = shift;
+    $self->get_cache;
+
+    return scalar( @{ $self->{cache} } ) - 1;
+}
+
+sub port_id_get_by_number($$) {
+    my ( $self, $number ) = @_;
+    return $number;
+}
+
+sub port_name_get($$) {
+    my ( $self, $number ) = @_;
+
+    $self->get_cache;
+
+    return $self->{cache}->[$number]->{name}
+      if length( $self->{cache}->[$number]->{name} ) > 0;
+
+    return sprintf "Port %02d", $number;
+}
+
+sub port_name_set($$$) {
+    my ( $self, $number, $name ) = @_;
+
+    $self->get_cache;
+
+    $name =~ s/ /_/g;
+
+    $self->{telnet}->print( "name " . $number . " " . $name );
+    $self->get_until_match( "pm>", 1.3 );
+
+    $self->{telnet}->print("save");
+    $self->get_until_match( "pm>", 1.3 );
+
+    $self->update_cache($number);
+
+}
+
+sub port_state_get($$) {
+    my ( $self, $number ) = @_;
+
+    $self->get_cache;
+
+    my $ret = $self->{cache}->[$number]->{state};
+
+    $ret =~ s/Unlocked //g;
+
+    return $ret;
+}
+
+sub port_state_get_no_cache($$) {
+    my ( $self, $number ) = @_;
+
+    if ( $self->{lie} == 1 ) {
+        $self->{lie} = 0;
+        return "Off";
+    }
+
+    $self->update_cache($number);
+    return $self->port_state_get($number);
+}
+
+sub port_off($$) {
+    my ( $self, $number ) = @_;
+    $self->{telnet}->print( "off " . $number );
+    $self->get_until_match( "pm>", 1, 3 );
+}
+
+sub port_on($$) {
+    my ( $self, $number ) = @_;
+    $self->{telnet}->print( "on " . $number );
+    $self->get_until_match( "pm>", 1.3 );
+}
+
+sub port_cycle($$) {
+    my ( $self, $number ) = @_;
+    $self->{telnet}->print( "cycle " . $number );
+    $self->get_until_match( "pm>", 1.60 );
+}
+
+sub logout($) {
+    my $self = shift;
+}
+
+sub new ($;$) {
+    my ( $class, $parm ) = @_;
+    my $self;
+
+    $self->{host}     = $parm->{host}     || "redbus-ms20.mythic-beasts.com";
+    $self->{username} = $parm->{username} || "admin";
+    $self->{password} = $parm->{password} || "pm8";
+
+    if ( $self->{host} =~ /^(.*):(.*)$/ ) {
+        $self->{iphost} = $1;
+        $self->{vmunit} = $2;
+    }
+    else {
+        $self->{iphost} = $self->{host};
+    }
+
+    $self->{telnet} = new Net::Telnet(
+        Timeout => 10,
+        Prompt  => '/pm>/',
+
+        #        Dump_Log => STDERR,
+        Binmode => 1
+    );
+
+    $self->{lie} = 0;
+
+    $self = bless $self, $class;
+
+    $self->{telnet}->open( $self->{iphost} );
+
+    unless ( $self->sync ) {
+        $self->{telnet}->close;
+        return undef;
+    }
+
+    return $self;
+}
+
+1;