Games-Axmud
view release on metacpan or search on metacpan
lib/Games/Axmud/Session.pm view on Meta::CPAN
# When $self->worldCmd is called with a string of world commands (e.g.
# 'north;east;north'), we don't want to redraw the automapper's ghost room once for
# each movement command (of which there might be hundreds)
# Instead, the function temporarily stores the ghost room (if one exists at the time
# the function is called) here, to guarantee that it gets redrawn
worldCmdGhostRoom => undef,
# Delayed quit. If this IV is set, it is the moment in the future (matches
# $self->sessionTime) at which some kind of 'quit' or 'exit' client command must be
# performed
delayedQuitTime => undef,
# When it's time to perform the delayed quit, the actual client command to use - will
# be one of 'quit', 'qquit', 'exit', 'xxit' (the ';' sigil is not required)
# NB The client commands ';quitall' / ';exitall' set these IVs in every session
delayedQuitCmd => undef,
# The disconnection time (a real clock time), set upon disconnection, and used to
# update the 'main' window's connection info host label. Set to 'undef' until
# $self->status changes from 'connected' to 'disconnected'
disconnectTime => undef,
# Timer loop
# ----------
# The timer loop delay, in seconds (can be changed while the session is running, but
# should not be set lower than $self->sessionLoopDelay)
timerLoopDelay => 0.1,
# The time at which the timer loop should next spin (i.e. the time at which
# $self->spinSessionLoop should call $self->spinTimerLoop)
# When set to 'undef', the loop is not running at all; the first time it spins, set to 0
timerLoopCheckTime => undef,
# Incoming data loop
# ------------------
# The incoming data loop delay, in seconds (can be changed while the session is running,
# but should not be set lower than $self->sessionLoopDelay)
incomingLoopDelay => 0.1,
# The time at which the incoming data loop should next spin (i.e. the time at which
# $self->spinSessionLoop should call $self->spinIncomingLoop)
# When set to 'undef', the loop is not running at all; the first time it spins, set to 0
incomingLoopCheckTime => undef,
# An emergency buffer used for invalid escape sequences which are probably the result of
# a valid escape sequence split over two packets, the second of which hasn't been
# received yet. Set and reset by $self->processIncomingData
emergencyBuffer => undef,
# The world's host address and port (the ones actually used, not the ones supplied by
# the calling function - just in case they are different)
host => undef,
port => undef,
# Which connection protocol this session is using: 'telnet', 'ssh' or 'ssl' ('undef'
# when not connected)
protocol => undef,
# The GA::Obj::Telnet handling the connection ('undef' when not connected)
connectObj => undef,
# For SSH connections, the Net::OpenSSH and Perl pty (an IO::Tty filehandle) objects
# ('undef' for telnet/SSL connections and when not connected)
sshObj => undef,
ptyObj => undef,
# For SSL connections, the IO::Socket::SSL object ('undef' for telnet/SSH connections
# and when not connected)
sslObj => undef,
# The number of packets received (i.e. the number of times $self->processIncomingData
# has been called) during this session
packetCount => 0,
# The current connection status:
# 'waiting' - The first connection hasn't been attempted yet
# 'connecting' - Attempting to connect
# 'connected' - Connected to the remote host
# 'offline' - Session opened in 'connect offline' mode
# 'disconnected' - Disconnected from the remote host (or connection failed, or an
# 'offline' mode session has finished, or an MXP crosslinking
# operation is in progress)
status => 'waiting',
# On disconnection, $self->reactDisconnect might be called before $self->doDisconnect
# has finished (such as during blind mode, when the 'Disconnected' message is still
# being read aloud)
# On the call to ->doDisconnect, this flag is set to TRUE. When the call finishes, it is
# set back to FALSE. ->reactDisconnect (if called) won't do anything if this flag ist
# TRUE
doDisconnectFlag => FALSE,
# On disconnection, $self->reactDisconnect is called from several places in the session
# code. In rare circumstances (such as the GA::Obj::Telnet object returning TRUE to
# an ->eof() call), it might be called more than once
# On the first call, this flag is set to TRUE. On any subsequent calls, nothing happens
# if this flag is TRUE
reactDisconnectFlag => FALSE,
# $self->processIncomingData tokenises the incoming data, and then processes the tokens,
# one at a time. When it's time to display a complete or partial line, it calls
# $sef->respondIncomingData
# However, some tokens (particularly MXP tokens) can't be fully processed while there
# are tokens waiting to be displayed (e.g. when switching between MXP frames)
# To cope with that, these IVs are set every time ->processIncomingData processes a
# token, and are reset every time $self->respondIncomingData is called
# In that way, when the MXP tag <FRAME> is processed with a call to
# $self->processMxpFrameElement, that function can force all undisplayed tokens to be
# displayed (using a call to $self->respondIncomingData), before processing the
# token containing the <FRAME> tag
# The complete or partial line received from the world, before any non-text tokens are
# removed
processOrigLine => '',
# The same complete or partial line with all non-text tokens removed
processStripLine => '',
# A hash of the stripped Axmud colour/style tags, in the form
# $processTagHash{line_offset} = reference_to_list_of_tags
# NB To keep the code simple, the hash always contains an entry corresponding to the
# start of the string in $self->processStripLine
processTagHash => {
0 => [],
},
# When $self->processIncomingData processes tokens, it calls a function to handle each
# type of token. If one of the called functions needs to display a partial line,
# it calls $self->respondIncomingData early
# All calls to $self->respondIncomingData set this flag to TRUE, so that the loop in
# $self->processIncomingData knows to update, not replace, the IVs ->processOrigLine,
# ->processStripLine and ->processTagHash
processRetainFlag => FALSE,
# This IV is generally the same as $self->processStripLine, but with a description of
# each image drawn. It's set whenever a text token or image is processed, and only
lib/Games/Axmud/Session.pm view on Meta::CPAN
# 'jsmith@2001:db8::1428:57ab'); # IPv6
# In addition, IPv6 addresses can be enclosed in brackets (which we will do)
# 'jsmith@[::1]:1022'
# Compose the first argument
$longHost = $user;
if ($pass) {
$longHost .= ':' . $pass;
}
if ($self->currentWorld->ipv6 && $self->currentWorld->ipv6 eq $host) {
$longHost .= '@[' . $host . ']';
} else {
$longHost .= '@' . $host;
}
if ($self->currentWorld->sshPortFlag) {
$longHost .= ':' . $port;
}
# Connect using Net::OpenSSH
$sshObj = Net::OpenSSH->new(
$longHost,
timeout => $self->connectTimeOut,
master_opts => [ -o => "StrictHostKeyChecking=no" ],
);
if ($sshObj) {
($ptyObj, $pid) = $sshObj->open2pty();
if ($ptyObj) {
$connectObj = Games::Axmud::Obj::Telnet->new(
-fhopen => $ptyObj,
Axmud_session => $self,
Errmode => 'return',
Timeout => $self->connectTimeOut,
);
}
}
if (! $connectObj) {
$self->writeError(
'System SSH error',
$self->_objClass . '->doConnect',
);
# React to the disconnection
$self->reactDisconnect();
# Return 'undef' to show failure
return undef;
}
} elsif ($protocol eq 'ssl') {
# Connect using IO::Socket::SSL and GA::Obj::Telnet
$sslObj = IO::Socket::SSL->new(
PeerAddr => $host,
PeerPort => $port,
SSL_verify_mode => 0x00,
);
if ($sslObj) {
$connectObj = Games::Axmud::Obj::Telnet->new(
-fhopen => $sslObj,
Axmud_session => $self,
Errmode => 'return',
Timeout => $self->connectTimeOut,
);
}
if (! $connectObj) {
$self->writeError(
'System SSL error',
$self->_objClass . '->doConnect',
);
# React to the disconnection
$self->reactDisconnect();
# Return 'undef' to show failure
return undef;
}
}
# Telnet option / sub-option negotiation
$connectObj->option_callback(sub {
my ($obj, $option, $isRemote, $isEnabled, $wasEnabled, $bufPosn) = @_;
return $self->optCallback(
$obj,
$option,
$isRemote,
$isEnabled,
$wasEnabled,
$bufPosn,
);
});
$connectObj->suboption_callback(sub {
my ($obj, $option, $parameters) = @_;
return $self->subOptCallback($obj, $option, $parameters);
});
# Use GA::Obj::Telnet's option negotiation ability to write logfiles, if the GA::Client's
# flag is set
if ($axmud::CLIENT->debugTelnetLogFlag) {
$connectObj->option_log($axmud::TOP_DIR . '/telopt.log');
}
# Prepare telnet options
$self->prepareTelnetOptions($connectObj);
# Prepare MUD protocols
$self->prepareMudProtocols($connectObj);
if ($protocol eq 'telnet') {
$connectObj->open(
Host => $host,
Port => $port,
Family => 'any', # Permit ipv4 or ipv6
Errmode => sub { return $self->connectionError(shift); },
);
} else {
# For SSH, ivp4/ipv6 is already supported by the code above
# For SSL, ipv4 and ipv6 are already enabled, due to IO::Socket::SSL being able to call
# on IO::Socket::INET6
$connectObj->errmode( sub { return $self->connectionError(shift); } );
}
# If the connection is refused (e.g. an invalid host is specified),
# $self->connectionError will be called before the following lines of code can be
# executed.
if ($self->status ne 'disconnected' && $self->status ne 'offline') {
# Update IVs
$self->ivPoke('connectObj', $connectObj);
$self->ivPoke('sshObj', $sshObj);
$self->ivPoke('ptyObj', $ptyObj);
$self->ivPoke('sslObj', $sslObj);
$self->ivPoke('host', $host);
$self->ivPoke('port', $port);
}
return 1;
}
sub doDisconnect {
# Called by $self->stop and also by GA::Cmd::Exit->do, XXit->do, etc
# Terminates the connection immediately (if $self->status is 'connecting' or 'connected')
# (Hooks using the 'disconnect' event do not fire)
#
# Expected arguments
# (none besides $self)
#
# Optional arguments
# $flag - If TRUE, don't update IVs, because the calling function is about to call
# ->reactDisconnect to handle that. If FALSE (or 'undef'), IVs are updated
#
# Return values
# 'undef' on improper arguments
# 1 otherwise
my ($self, $flag, $check) = @_;
# Check for improper arguments
if (defined $check) {
return $axmud::CLIENT->writeImproper($self->_objClass . '->doDisconnect', @_);
}
# On disconnection, $self->reactDisconnect might be called before $self->doDisconnect has
# finished (such as during blind mode, when the 'Disconnected' message is still being read
# aloud). Use a flag to prevent ->reactDisconnect doing anything until this function is
# finished
$self->ivPoke('doDisconnectFlag', TRUE);
# Turn off overwrite mode in the session's default textview object (if on), allowing
# disconnection messages to be visible
# Also turn off the visible cursor
if ($self->defaultTabObj) {
$self->defaultTabObj->textViewObj->disableOverwrite();
$self->defaultTabObj->textViewObj->set_cursorEnableFlag(FALSE);
}
( run in 4.022 seconds using v1.01-cache-2.11-cpan-39bf76dae61 )