view release on metacpan or  search on metacpan

lib/Net/Telnet.pm  view on Meta::CPAN

package Net::Telnet;

## Copyright 1997, 2000, 2002, 2013, 2021 Jay Rogers.  All rights reserved.
## This program is free software; you can redistribute it and/or
## modify it under the same terms as Perl itself.

## See user documentation at the end of this file.  Search for =head

use strict;
require 5.002;

## Module export.
use vars qw(@EXPORT_OK);
@EXPORT_OK = qw(TELNET_IAC TELNET_DONT TELNET_DO TELNET_WONT TELNET_WILL
                TELNET_SB TELNET_GA TELNET_EL TELNET_EC TELNET_AYT TELNET_AO
                TELNET_IP TELNET_BREAK TELNET_DM TELNET_NOP TELNET_SE
                TELNET_EOR TELNET_ABORT TELNET_SUSP TELNET_EOF TELNET_SYNCH
                TELOPT_BINARY TELOPT_ECHO TELOPT_RCP TELOPT_SGA TELOPT_NAMS
                TELOPT_STATUS TELOPT_TM TELOPT_RCTE TELOPT_NAOL TELOPT_NAOP
                TELOPT_NAOCRD TELOPT_NAOHTS TELOPT_NAOHTD TELOPT_NAOFFD
                TELOPT_NAOVTS TELOPT_NAOVTD TELOPT_NAOLFD TELOPT_XASCII
                TELOPT_LOGOUT TELOPT_BM TELOPT_DET TELOPT_SUPDUP
                TELOPT_SUPDUPOUTPUT TELOPT_SNDLOC TELOPT_TTYPE TELOPT_EOR
                TELOPT_TUID TELOPT_OUTMRK TELOPT_TTYLOC TELOPT_3270REGIME
                TELOPT_X3PAD TELOPT_NAWS TELOPT_TSPEED TELOPT_LFLOW
                TELOPT_LINEMODE TELOPT_XDISPLOC TELOPT_OLD_ENVIRON
                TELOPT_AUTHENTICATION TELOPT_ENCRYPT TELOPT_NEW_ENVIRON
                TELOPT_TN3270E TELOPT_CHARSET TELOPT_COMPORT TELOPT_KERMIT
                TELOPT_EXOPL);

## Module import.
use Exporter ();
use Socket qw(AF_INET SOCK_STREAM inet_aton sockaddr_in);
use Symbol qw(qualify);

## Base classes.
use vars qw(@ISA);
@ISA = qw(Exporter);
if (&_import_io_socket) {  # successfully required module IO::Socket
    push @ISA, "IO::Socket::INET";
}
else {  # perl version < 5.004
    &_import_filehandle;
    push @ISA, "FileHandle";
}
my $AF_INET6 = &_import_af_inet6();
my $AF_UNSPEC = &_import_af_unspec() || 0;
my $AI_ADDRCONFIG = &_import_ai_addrconfig() || 0;
my $EAI_BADFLAGS = &_import_eai_badflags() || -1;
my $EINTR = &_import_eintr();

## Global variables.
use vars qw($VERSION @Telopts);
$VERSION = "3.05";
@Telopts = ("BINARY", "ECHO", "RCP", "SUPPRESS GO AHEAD", "NAMS", "STATUS",
            "TIMING MARK", "RCTE", "NAOL", "NAOP", "NAOCRD", "NAOHTS",
            "NAOHTD", "NAOFFD", "NAOVTS", "NAOVTD", "NAOLFD", "EXTEND ASCII",
            "LOGOUT", "BYTE MACRO", "DATA ENTRY TERMINAL", "SUPDUP",
            "SUPDUP OUTPUT", "SEND LOCATION", "TERMINAL TYPE", "END OF RECORD",
            "TACACS UID", "OUTPUT MARKING", "TTYLOC", "3270 REGIME", "X.3 PAD",
            "NAWS", "TSPEED", "LFLOW", "LINEMODE", "XDISPLOC", "OLD-ENVIRON",
            "AUTHENTICATION", "ENCRYPT", "NEW-ENVIRON", "TN3270E", "XAUTH",
            "CHARSET", "RSP", "COMPORT", "SUPPRESS LOCAL ECHO", "START TLS",
            "KERMIT");


########################### Public Methods ###########################


sub new {
    my ($class) = @_;
    my (
        $dump_log,
        $errmode,
        $family,
        $fh_open,
        $host,
        $input_log,
        $localfamily,
        $option_log,
        $output_log,
        $port,
        $prompt,
        $self,
        %args,
        );
    local $_;

    ## Create a new object with defaults.
    $self = $class->SUPER::new;
    *$self->{net_telnet} = {
        bin_mode         => 0,
        blksize          => &_optimal_blksize(),
        buf              => "",
        cmd_prompt       => '/[\$%#>] $/',
        cmd_rm_mode      => "auto",
        dumplog          => '',
        eofile           => 1,
        errormode        => "die",
        errormsg         => "",
        fdmask           => '',
        host             => "localhost",
        inputlog         => '',
        last_line        => "",
        last_prompt      => "",
        local_family     => "ipv4",

lib/Net/Telnet.pm  view on Meta::CPAN

    1;
} # end sub _fillbuf


sub _flush_opts {
    my ($self) = @_;
    my (
        $option_chars,
        );
    my $s = *$self->{net_telnet};

    ## Get option and clear the output buf.
    $option_chars = $s->{unsent_opts};
    $s->{unsent_opts} = "";

    ## Try to send options without waiting.
    {
        local $s->{errormode} = "return";
        local $s->{time_out} = 0;
        &_put($self, \$option_chars, "telnet option negotiation")
            or do {
                ## Save chars not printed for later.
                substr($option_chars, 0, $self->print_length) = "";
                $s->{unsent_opts} .= $option_chars;
            };
    }

    1;
} # end sub _flush_opts


sub _fname_to_handle {
    my ($self, $filename) = @_;
    my (
        $fh,
        );
    no strict "refs";

    $fh = &_new_handle();
    CORE::open $fh, "> $filename"
        or return $self->error("problem creating $filename: $!");

    $fh;
} # end sub _fname_to_handle


sub _have_alarm {
    local $@;

    eval {
        local $SIG{"__DIE__"} = "DEFAULT";
        local $SIG{ALRM} = sub { die };
        alarm 0;
    };

    ! $@;
} # end sub _have_alarm


sub _import_af_inet6 {
    local $@;

    eval {
        local $SIG{"__DIE__"} = "DEFAULT";

        Socket::AF_INET6();
    };
} # end sub _import_af_inet6


sub _import_af_unspec {
    local $@;

    eval {
        local $SIG{"__DIE__"} = "DEFAULT";

        Socket::AF_UNSPEC();
    };
} # end sub _import_af_unspec


sub _import_ai_addrconfig {
    local $@;

    eval {
        local $SIG{"__DIE__"} = "DEFAULT";

        Socket::AI_ADDRCONFIG();
    };
} # end sub _import_ai_addrconfig


sub _import_eai_badflags {
    local $@;

    eval {
        local $SIG{"__DIE__"} = "DEFAULT";

        Socket::EAI_BADFLAGS();
    };
} # end sub _import_eai_badflags


sub _import_eintr {
    local $@;
    local $SIG{"__DIE__"} = "DEFAULT";

    eval "require Errno; Errno::EINTR();";
} # end sub _import_eintr


sub _import_filehandle {
    local $@;
    local $SIG{"__DIE__"} = "DEFAULT";

    ## This eval is a workaround for a bug in perl 5.10.1
    eval "require FileHandle";
    if ($@) {
        die $@;
    }

    1;
} # end sub _import_filehandle


sub _import_io_socket {
    local $@;
    local $SIG{"__DIE__"} = "DEFAULT";