view release on metacpan or  search on metacpan

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

package Net::Telnet;

## Copyright 1997, 2000, 2002, 2013 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 (&_io_socket_include) {  # successfully required module IO::Socket
    push @ISA, "IO::Socket::INET";
}
else {  # perl version < 5.004
    require 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 _interpret_cr {
    my ($s, $pos) = @_;
    my (
	$nextchar,
	);

    while (($pos = index($s->{buf}, "\015", $pos)) > -1) {
	$nextchar = substr($s->{buf}, $pos + 1, 1);
	if ($nextchar eq "\0") {
	    ## Convert CR NULL to CR when in telnet mode.
	    if ($s->{telnet_mode}) {
		substr($s->{buf}, $pos + 1, 1) = "";
	    }
	}
	elsif ($nextchar eq "\012") {
	    ## Convert CR LF to newline when not in binary mode.
	    if (!$s->{bin_mode}) {