| 1 | # Documentation at the __END__ |
| 2 | |
| 3 | package IO::Tty; |
| 4 | |
| 5 | use IO::Handle; |
| 6 | use IO::File; |
| 7 | use IO::Tty::Constant; |
| 8 | use Carp; |
| 9 | |
| 10 | require POSIX; |
| 11 | require DynaLoader; |
| 12 | |
| 13 | use vars qw(@ISA $VERSION $XS_VERSION $CONFIG $DEBUG); |
| 14 | |
| 15 | $VERSION = 1.02; |
| 16 | $XS_VERSION = "1.02"; |
| 17 | @ISA = qw(IO::Handle); |
| 18 | |
| 19 | eval { local $^W = 0; undef local $SIG{__DIE__}; require IO::Stty }; |
| 20 | push @ISA, "IO::Stty" if (not $@); # if IO::Stty is installed |
| 21 | |
| 22 | BOOT_XS: { |
| 23 | # If I inherit DynaLoader then I inherit AutoLoader and I DON'T WANT TO |
| 24 | require DynaLoader; |
| 25 | |
| 26 | # DynaLoader calls dl_load_flags as a static method. |
| 27 | *dl_load_flags = DynaLoader->can('dl_load_flags'); |
| 28 | |
| 29 | do { |
| 30 | defined(&bootstrap) |
| 31 | ? \&bootstrap |
| 32 | : \&DynaLoader::bootstrap |
| 33 | }->(__PACKAGE__); |
| 34 | } |
| 35 | |
| 36 | sub import { |
| 37 | IO::Tty::Constant->export_to_level(1, @_); |
| 38 | } |
| 39 | |
| 40 | sub open { |
| 41 | my($tty,$dev,$mode) = @_; |
| 42 | |
| 43 | IO::File::open($tty,$dev,$mode) or |
| 44 | return undef; |
| 45 | |
| 46 | $tty->autoflush; |
| 47 | |
| 48 | 1; |
| 49 | } |
| 50 | |
| 51 | sub clone_winsize_from { |
| 52 | my ($self, $fh) = @_; |
| 53 | my $winsize = ""; |
| 54 | croak "Given filehandle is not a tty in clone_winsize_from, called" |
| 55 | if not POSIX::isatty($fh); |
| 56 | return 1 if not POSIX::isatty($self); # ignored for master ptys |
| 57 | ioctl($fh, &IO::Tty::Constant::TIOCGWINSZ, $winsize) |
| 58 | and ioctl($self, &IO::Tty::Constant::TIOCSWINSZ, $winsize) |
| 59 | and return 1; |
| 60 | warn "clone_winsize_from: error: $!" if $^W; |
| 61 | return undef; |
| 62 | } |
| 63 | |
| 64 | sub set_raw($) { |
| 65 | require POSIX; |
| 66 | my $self = shift; |
| 67 | return 1 if not POSIX::isatty($self); |
| 68 | my $ttyno = fileno($self); |
| 69 | my $termios = new POSIX::Termios; |
| 70 | unless ($termios) { |
| 71 | warn "set_raw: new POSIX::Termios failed: $!"; |
| 72 | return undef; |
| 73 | } |
| 74 | unless ($termios->getattr($ttyno)) { |
| 75 | warn "set_raw: getattr($ttyno) failed: $!"; |
| 76 | return undef; |
| 77 | } |
| 78 | $termios->setiflag(0); |
| 79 | $termios->setoflag(0); |
| 80 | $termios->setlflag(0); |
| 81 | $termios->setcc(&POSIX::VMIN, 1); |
| 82 | $termios->setcc(&POSIX::VTIME, 0); |
| 83 | unless ($termios->setattr($ttyno, &POSIX::TCSANOW)) { |
| 84 | warn "set_raw: setattr($ttyno) failed: $!"; |
| 85 | return undef; |
| 86 | } |
| 87 | return 1; |
| 88 | } |
| 89 | |
| 90 | |
| 91 | 1; |
| 92 | |
| 93 | __END__ |
| 94 | |
| 95 | =head1 NAME |
| 96 | |
| 97 | IO::Tty - Low-level allocate a pseudo-Tty, import constants. |
| 98 | |
| 99 | =head1 VERSION |
| 100 | |
| 101 | 1.02 |
| 102 | |
| 103 | =head1 SYNOPSIS |
| 104 | |
| 105 | use IO::Tty qw(TIOCNOTTY); |
| 106 | ... |
| 107 | # use only to import constants, see IO::Pty to create ptys. |
| 108 | |
| 109 | =head1 DESCRIPTION |
| 110 | |
| 111 | C<IO::Tty> is used internally by C<IO::Pty> to create a pseudo-tty. |
| 112 | You wouldn't want to use it directly except to import constants, use |
| 113 | C<IO::Pty>. For a list of importable constants, see |
| 114 | L<IO::Tty::Constant>. |
| 115 | |
| 116 | Windows is now supported, not natively but under the Cygwin |
| 117 | environment, see L<http://sources.redhat.com/cygwin/>. |
| 118 | |
| 119 | Please note that pty creation is very system-dependend. From my |
| 120 | experience, any modern POSIX system should be fine. Find below a list |
| 121 | of systems that C<IO::Tty> should work on. A more detailed table is |
| 122 | available from the project pages document manager at SourceForge |
| 123 | L<http://sourceforge.net/projects/expectperl/>. |
| 124 | |
| 125 | If you have problems on your system and your system is listed in the |
| 126 | "verified" list, you probably have some non-standard setup, e.g. you |
| 127 | compiled your Linux-kernel yourself and disabled ptys (bummer!). |
| 128 | Please ask your friendly sysadmin for help. |
| 129 | |
| 130 | If your system is not listed, unpack the latest version of C<IO::Tty>, |
| 131 | do a C<'perl Makefile.PL; make; make test; uname -a'> and send me |
| 132 | (F<RGiersig@cpan.org>) the results and I'll see what I can deduce from |
| 133 | that. There are chances that it will work right out-of-the-box... |
| 134 | |
| 135 | If it's working on your system, please send me a short note with |
| 136 | details (version number, distribution, etc. C<'uname -a'> is a good |
| 137 | start) so I can get an overview. Thanks! |
| 138 | |
| 139 | |
| 140 | =head1 VERIFIED SYSTEMS, KNOWN ISSUES |
| 141 | |
| 142 | This is a list of systems that C<IO::Tty> seems to work on ('make |
| 143 | test' passes) with comments about "features": |
| 144 | |
| 145 | =over 4 |
| 146 | |
| 147 | =item * AIX 4.3 |
| 148 | |
| 149 | Returns EIO instead of EOF when the slave is closed. Benign. |
| 150 | |
| 151 | =item * FreeBSD 4.4 |
| 152 | |
| 153 | EOF on the slave tty is not reported back to the master. |
| 154 | |
| 155 | =item * OpenBSD 2.8 |
| 156 | |
| 157 | The ioctl TIOCSCTTY sometimes fails. This is also known in |
| 158 | Tcl/Expect, see http://expect.nist.gov/FAQ.html |
| 159 | |
| 160 | EOF on the slave tty is not reported back to the master. |
| 161 | |
| 162 | =item * HPUX 10.20 & 11.00 |
| 163 | |
| 164 | EOF on the slave tty is not reported back to the master. |
| 165 | |
| 166 | =item * IRIX 6.5 |
| 167 | |
| 168 | =item * Linux 2.2.x & 2.4.x |
| 169 | |
| 170 | Returns EIO instead of EOF when the slave is closed. Benign. |
| 171 | |
| 172 | =item * OSF 4.0 |
| 173 | |
| 174 | EOF on the slave tty is not reported back to the master. |
| 175 | |
| 176 | =item * Solaris 8, 2.7, 2.6 |
| 177 | |
| 178 | Has the "feature" of returning EOF just once?! |
| 179 | |
| 180 | EOF on the slave tty is not reported back to the master. |
| 181 | |
| 182 | =item * Windows NT/2k (under Cygwin) |
| 183 | |
| 184 | When you send (print) a too long line (>160 chars) to a non-raw pty, |
| 185 | the call just hangs forever and even alarm() cannot get you out. |
| 186 | Don't complain to me... |
| 187 | |
| 188 | EOF on the slave tty is not reported back to the master. |
| 189 | |
| 190 | =back |
| 191 | |
| 192 | The following systems have not been verified yet for this version, but |
| 193 | a previous version worked on them: |
| 194 | |
| 195 | =over 4 |
| 196 | |
| 197 | =item * SCO Unix |
| 198 | |
| 199 | =item * NetBSD |
| 200 | |
| 201 | probably the same as the other *BSDs... |
| 202 | |
| 203 | =back |
| 204 | |
| 205 | If you have additions to these lists, please mail them to |
| 206 | E<lt>F<RGiersig@cpan.org>E<gt>. |
| 207 | |
| 208 | |
| 209 | =head1 SEE ALSO |
| 210 | |
| 211 | L<IO::Pty>, L<IO::Tty::Constant> |
| 212 | |
| 213 | |
| 214 | =head1 MAILING LISTS |
| 215 | |
| 216 | As this module is mainly used by Expect, support for it is available |
| 217 | via the two Expect mailing lists, expectperl-announce and |
| 218 | expectperl-discuss, at |
| 219 | |
| 220 | http://lists.sourceforge.net/lists/listinfo/expectperl-announce |
| 221 | |
| 222 | and |
| 223 | |
| 224 | http://lists.sourceforge.net/lists/listinfo/expectperl-discuss |
| 225 | |
| 226 | |
| 227 | =head1 AUTHORS |
| 228 | |
| 229 | Originally by Graham Barr E<lt>F<gbarr@pobox.com>E<gt>, based on the |
| 230 | Ptty module by Nick Ing-Simmons E<lt>F<nik@tiuk.ti.com>E<gt>. |
| 231 | |
| 232 | Now maintained and heavily rewritten by Roland Giersig |
| 233 | E<lt>F<RGiersig@cpan.org>E<gt>. |
| 234 | |
| 235 | Contains copyrighted stuff from openssh v3.0p1, authored by Tatu |
| 236 | Ylonen <ylo@cs.hut.fi>, Markus Friedl and Todd C. Miller |
| 237 | <Todd.Miller@courtesan.com>. I also got a lot of inspiry from the pty |
| 238 | code in Xemacs. |
| 239 | |
| 240 | |
| 241 | =head1 COPYRIGHT |
| 242 | |
| 243 | Now all code is free software; you can redistribute it and/or modify |
| 244 | it under the same terms as Perl itself. |
| 245 | |
| 246 | Nevertheless the above AUTHORS retain their copyrights to the various |
| 247 | parts and want to receive credit if their source code is used. |
| 248 | See the source for details. |
| 249 | |
| 250 | |
| 251 | =head1 DISCLAIMER |
| 252 | |
| 253 | THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED |
| 254 | WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF |
| 255 | MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. |
| 256 | IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, |
| 257 | INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, |
| 258 | BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS |
| 259 | OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND |
| 260 | ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR |
| 261 | TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE |
| 262 | USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH |
| 263 | DAMAGE. |
| 264 | |
| 265 | In other words: Use at your own risk. Provided as is. Your mileage |
| 266 | may vary. Read the source, Luke! |
| 267 | |
| 268 | And finally, just to be sure: |
| 269 | |
| 270 | Any Use of This Product, in Any Manner Whatsoever, Will Increase the |
| 271 | Amount of Disorder in the Universe. Although No Liability Is Implied |
| 272 | Herein, the Consumer Is Warned That This Process Will Ultimately Lead |
| 273 | to the Heat Death of the Universe. |
| 274 | |
| 275 | =cut |