Mailing List Archive: gift

It also needs WIN32 support POSIX::Termios is not supported under
winbloze.

Chris

On Fri, 2003-04-25 at 16:03, Christopher Fowler wrote:
> Don't say I don't give anything back :)
>
> Someone mod this to support all command line options. And clean it
> up a bit.
>
>
>
>
> ----
>

> #!/usr/bin/perl
>
>
> sub cpanMirrorSpeak {
> my $mod = $_[0];
> die <<EOT;
> You don't have $mod installed. Please install a copy from your
> favourite CPAN mirror.
>
> perl -MCPAN -e 'install( "$mod" )'
> EOT
> }
>
> eval { require POSIX; };
> if( $@ ) {
> cpanMirrorSpeak("POSIX");
> }
>
> eval { require IO::Socket; };
> if( $@ ) {
> cpanMirrorSpeak("IO::Socket");
> }
>
> eval { require Getopt::Std; };
> if( $@ ) {
> cpanMirrorSpeak("Getopt::Std");
> }
>
> eval { require IO::Select; };
> if( $@ ) {
> cpanMirrorSpeak("IO::Select");
> }
>
> use Getopt::Std;
> use POSIX;
> use IO::Socket;
> use IO::Select;
> use strict;
>
> # Static variables
> my $USER;
> my $SERVER;
> my $CONSOLE;
>
>
> # Commands
> my $CMD_LOGIN = "c;";
>
>
> sub console_syntax {
> die "$0 [-h] -s <server> -u <user> <console>\n";
> }
>
> sub console_pArgs {
> console_syntax() unless (getopts("s:u:h"));
> console_syntax() if not $Getopt::Std::opt_s;
> console_syntax() if not $Getopt::Std::opt_u;
> console_syntax() if $Getopt::Std::opt_h;
> console_syntax() if not @ARGV;
>
> $USER = $Getopt::Std::opt_u;
> $SERVER = $Getopt::Std::opt_s;
> $CONSOLE = $ARGV[0];
>
> return;
> }
>
> #
> # Implement enough of the portcommander protocol
> # to attach to the required console (or die trying),
> # return the live socket.
> #
> sub connect_console {
>
> my $SERVER = $_[0];
> my $CONSOLE = $_[1];
> my $USER = $_[2];
> my $PASS = $_[3];
> #
> # Create the socket to the main server
> # We'll recoeve a port number then connect to secondary
> # server for console data
> #
> my $sock = new IO::Socket::INET (PeerAddr => $SERVER,
> PeerPort => 782,
> Proto => 'tcp',) or
> return -1;
>
> # We do not want buffered output to socket
> $sock->autoflush();
>
> ($_ = <$sock>) ;
> return -1 unless /ok/ ;
>
> # Specify console name
> print $sock "call:$CONSOLE\n";
>
> # Only valid reply is a port number,
> # stick that in $1.
> ($_ = <$sock>);
> return -1 unless /^(\d+)/ ;
>
> close($sock);
>
>
> $sock = new IO::Socket::INET (PeerAddr => $SERVER,
> PeerPort => $1,
> Proto => 'tcp',) or
> return -1;
>
> $sock->autoflush();
> setsockopt($sock, SOL_SOCKET, SO_KEEPALIVE, 1);
>
> ($_ = <$sock>) ;
> return unless /ok/ ;
>
> # tell server we wish to log in
> print $sock $CMD_LOGIN;
>
> # TODO: test reply.
> ($_ = <$sock>) ;
>
> # specify user name
> print $sock "$USER\n";
> ($_ = <$sock>) ;
>
> if (/^host:/) {
> print $sock "$CONSOLE\n";
>
> #TODO
> #validate we are connected
> #to the console
> ($_ = <$sock>) ;
> }
>
> if (/^passwd:/) {
> print "Enter $USER\@$SERVER\'s password: ";
> $PASS = getPassword();
> print $sock "$PASS\n";
>
> ($_ = <$sock>) ;
> return -1 if (/Sorry/) ;
> }
>
> return $sock ;
> }
>
> sub getPassword {
>
> \*STDOUT->flush();
> \*STDIN->autoflush();
>
> my $t1 = POSIX::Termios->new;
> my $t2 = POSIX::Termios->new;
> $t1->getattr();
> $t2->getattr();
>
> my $c_lflag = $t1->getlflag();
> $t1->setlflag($c_lflag &= ~&POSIX::ECHO);
> $t1->setattr( 0, &POSIX::TCSANOW );
>
> my $pass;
> $pass = <STDIN>;
> chomp($pass);
> $t2->setattr( 0, &POSIX::TCSANOW );
>
> print "\n";
>
> return $pass;
> }
>
>
> # Main
> #
> my $cCon;
>
> console_pArgs();
> if(( $cCon = connect_console($SERVER, $CONSOLE, $USER, "password")) == -1) {
> die "Could not connect to console!\n";
> }
>
> print "[Enter `^Ec?' for help]\n";
> \*STDOUT->flush();
>
>
>
>
>
>
>
> sub cfmakeraw {
> my $tty = $_[0];
> $tty->getattr();
> my $c_iflag = $tty->getiflag();
> my $c_oflag = $tty->getoflag();
> my $c_lflag = $tty->getlflag();
> my $c_cflag = $tty->getcflag();
> $tty->setiflag($c_iflag &= ~&POSIX::IGNBRK);
> $tty->setiflag($c_iflag &= ~&POSIX::BRKINT);
> $tty->setiflag($c_iflag &= ~&POSIX::PARMRK);
> $tty->setiflag($c_iflag &= ~&POSIX::ISTRIP);
> $tty->setiflag($c_iflag &= ~&POSIX::INLCR);
> $tty->setiflag($c_iflag &= ~&POSIX::IGNCR);
> $tty->setiflag($c_iflag &= ~&POSIX::ICRNL);
> $tty->setiflag($c_iflag &= ~&POSIX::IXON);
> $tty->setoflag($c_oflag &= ~&POSIX::OPOST);
> $tty->setlflag($c_lflag &= ~&POSIX::ECHO);
> $tty->setlflag($c_lflag &= ~&POSIX::ECHONL);
> $tty->setlflag($c_lflag &= ~&POSIX::ICANON);
> $tty->setlflag($c_lflag &= ~&POSIX::ISIG);
> $tty->setlflag($c_lflag &= ~&POSIX::IEXTEN);
> $tty->setcflag($c_cflag &= ~&POSIX::CSIZE);
> $tty->setcflag($c_cflag &= ~&POSIX::PARENB);
> $tty->setcflag($c_cflag | &POSIX::CS8);
> }
>
> my $termios = POSIX::Termios->new;
> my $old = POSIX::Termios->new;
> $termios->getattr();
> $old->getattr();
> cfmakeraw($termios);
> $termios->setattr( 0, &POSIX::TCSANOW );
>
>
> #cfmakeraw sets the terminal attributes as follows:
> #termios_p->c_iflag &= ~(IGNBRK|BRKINT|PARMRK|ISTRIP
> #|INLCR|IGNCR|ICRNL|IXON);
> #termios_p->c_oflag &= ~OPOST;
> #termios_p->c_lflag &= ~(ECHO|ECHONL|ICANON|ISIG|IEXTEN);
> #termios_p->c_cflag &= ~(CSIZE|PARENB);
> #termios_p->c_cflag |= CS8;
>
>
> my $fdset = new IO::Select;
> my $wfdset = new IO::Select;
> my $r_ready;
> my $w_ready;
> my $error;
> my $timeout = 30;
> my $err;
>
> $fdset->add($cCon);
> $fdset->add(\*STDIN);
>
> while (1) {
>
> SELECT:
>
> ($r_ready, $w_ready, $error) =
> IO::Select->select($fdset, $wfdset, $err, $timeout);
>
> # If nothing has occured, we have timedout
> if($r_ready eq "") {
> goto SELECT;
> }
>
> foreach my $ready (@$r_ready) {
> my $data;
>
> if($ready == \*STDIN) {
> sysread($ready, $data, 1);
> print $cCon $data;
> }
>
> if($ready == $cCon) {
> if(sysread($ready, $data, 1) == 0) {
> $old->setattr( 1, &POSIX::TCSANOW );
> exit(0);
> }
> print $data;
> \*STDOUT->flush();
> }
> }
> }
>
>
> ----
>

> _______________________________________________
> users mailing list
> users@conserver.com
> https://www.conserver.com/mailman/listinfo/users

Mailing List Archive

Mailing List Archive

Attached Files: