IO-Tty-1.28/000755 000765 000024 00000000000 15172373622 013020 5ustar00toddrstaff000000 000000 IO-Tty-1.28/PaxHeader/Tty.pm000755 000765 000024 00000000210 15172373466 016111 xustar00toddrstaff000000 000000 30 mtime=1776940854.810432118 57 LIBARCHIVE.xattr.com.apple.provenance=AQIAgoHgHCklCGI 49 SCHILY.xattr.com.apple.provenance=)%b IO-Tty-1.28/Tty.pm000755 000765 000024 00000015174 15172373466 014157 0ustar00toddrstaff000000 000000 # Documentation at the __END__ # -*-cperl-*- package IO::Tty; use 5.008008; use strict; use warnings; use IO::Handle; use IO::File; use IO::Tty::Constant; use Carp; require POSIX; our @ISA = qw(IO::Handle); our $VERSION = '1.28'; our ( $CONFIG, $DEBUG ); eval { local $^W = 0; local $SIG{__DIE__}; require IO::Stty }; push @ISA, "IO::Stty" if ( not $@ ); # if IO::Stty is installed use XSLoader; XSLoader::load(__PACKAGE__, $VERSION); sub import { IO::Tty::Constant->export_to_level( 1, @_ ); } sub open { my ( $tty, $dev, $mode ) = @_; IO::File::open( $tty, $dev, $mode ) or return undef; $tty->autoflush; 1; } sub clone_winsize_from { my ( $self, $fh ) = @_; croak "Given filehandle is not a tty in clone_winsize_from, called" if not POSIX::isatty($fh); return 1 if not POSIX::isatty($self); # ignored for master ptys my $winsize = IO::Tty::pack_winsize( 0, 0, 0, 0 ); ioctl( $fh, &IO::Tty::Constant::TIOCGWINSZ, $winsize ) and ioctl( $self, &IO::Tty::Constant::TIOCSWINSZ, $winsize ) and return 1; carp "clone_winsize_from: error: $!"; return undef; } # ioctl() may pad the buffer beyond sizeof(struct winsize), # so trim it before passing to unpack_winsize. my $SIZEOF_WINSIZE = length IO::Tty::pack_winsize( 0, 0, 0, 0 ); sub get_winsize { my $self = shift; my $winsize = IO::Tty::pack_winsize( 0, 0, 0, 0 ); ioctl( $self, IO::Tty::Constant::TIOCGWINSZ(), $winsize ) or croak "Cannot TIOCGWINSZ - $!"; substr( $winsize, $SIZEOF_WINSIZE ) = ""; return IO::Tty::unpack_winsize($winsize); } sub set_winsize { my $self = shift; my $winsize = IO::Tty::pack_winsize(@_); ioctl( $self, IO::Tty::Constant::TIOCSWINSZ(), $winsize ) or croak "Cannot TIOCSWINSZ - $!"; } sub set_raw($) { require POSIX; my $self = shift; return 1 if not POSIX::isatty($self); my $ttyno = fileno($self); my $termios = POSIX::Termios->new; unless ($termios) { warn "set_raw: new POSIX::Termios failed: $!"; return undef; } unless ( $termios->getattr($ttyno) ) { warn "set_raw: getattr($ttyno) failed: $!"; return undef; } $termios->setiflag(0); $termios->setoflag(0); $termios->setlflag(0); $termios->setcflag( ( $termios->getcflag() & ~( &POSIX::CSIZE | &POSIX::PARENB ) ) | &POSIX::CS8 ); $termios->setcc( &POSIX::VMIN, 1 ); $termios->setcc( &POSIX::VTIME, 0 ); unless ( $termios->setattr( $ttyno, &POSIX::TCSANOW ) ) { warn "set_raw: setattr($ttyno) failed: $!"; return undef; } return 1; } 1; __END__ =for markdown [![testsuite](https://github.com/cpan-authors/IO-Tty/actions/workflows/testsuite.yml/badge.svg)](https://github.com/cpan-authors/IO-Tty/actions/workflows/testsuite.yml) =head1 NAME IO::Tty - Low-level allocate a pseudo-Tty, import constants. =head1 VERSION 1.28 =head1 SYNOPSIS use IO::Tty qw(TIOCNOTTY); ... # use only to import constants, see IO::Pty to create ptys. =head1 DESCRIPTION C is used internally by L to create a pseudo-tty. You wouldn't want to use it directly except to import constants, use L. For a list of importable constants, see L. Windows is now supported under the Cygwin environment, see L. Please note that pty creation is very system-dependent. Any modern POSIX system should be fine. The test suite is run via GitHub Actions CI on Linux, macOS, FreeBSD, OpenBSD, and NetBSD. If you have problems on your system and it is listed below, you probably have a non-standard setup, e.g. you compiled your Linux-kernel yourself and disabled ptys (bummer!). Please ask your friendly sysadmin for help. If your system is not listed, unpack the latest version of C, do a C<'perl Makefile.PL; make; make test; uname -a'> and report issues at L. =head1 PLATFORMS AND KNOWN ISSUES C is tested via CI on Linux, macOS, FreeBSD, OpenBSD, and NetBSD across multiple Perl versions. It is also known to work on AIX, Solaris/illumos, HP-UX, IRIX, z/OS, and Windows (under Cygwin). Known platform-specific behaviors: =over 4 =item * Linux, AIX Returns EIO instead of EOF when the slave is closed. Benign. =item * FreeBSD, OpenBSD, HP-UX, Solaris EOF on the slave tty is not reported back to the master. =item * OpenBSD The ioctl TIOCSCTTY sometimes fails. This is also known in Tcl/Expect. =item * Solaris Has the "feature" of returning EOF just once. =item * Cygwin When you send (print) a too long line (>160 chars) to a non-raw pty, the call just hangs forever and even alarm() cannot get you out. =back Please report issues at L. =head1 SEE ALSO L, L Source code and issue tracker at L. =head1 AUTHORS Originally by Graham Barr EFE, based on the Ptty module by Nick Ing-Simmons EFE. Heavily rewritten by Roland Giersig EFE. Currently maintained by Todd Rinaldo. Contains copyrighted stuff from openssh v3.0p1, authored by Tatu Ylonen , Markus Friedl and Todd C. Miller . =head1 COPYRIGHT Now all code is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Nevertheless the above AUTHORS retain their copyrights to the various parts and want to receive credit if their source code is used. See the source for details. =head1 DISCLAIMER THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. In other words: Use at your own risk. Provided as is. Your mileage may vary. Read the source, Luke! And finally, just to be sure: Any Use of This Product, in Any Manner Whatsoever, Will Increase the Amount of Disorder in the Universe. Although No Liability Is Implied Herein, the Consumer Is Warned That This Process Will Ultimately Lead to the Heat Death of the Universe. =cut IO-Tty-1.28/PaxHeader/ChangeLog000644 000765 000024 00000000210 15172373440 016532 xustar00toddrstaff000000 000000 30 mtime=1776940832.332555404 57 LIBARCHIVE.xattr.com.apple.provenance=AQIAgoHgHCklCGI 49 SCHILY.xattr.com.apple.provenance=)%b IO-Tty-1.28/ChangeLog000644 000765 000024 00000046316 15172373440 014602 0ustar00toddrstaff000000 000000 1.28 2026-04-23 Todd Rinaldo Bug Fixes: * PR #69 - Fix make_slave_controlling_terminal() on Solaris/HP-UX to use _open_tty() instead of IO::Tty->open(), ensuring STREAMS modules (ptem, ldterm, ttcompat) are pushed via I_PUSH when the slave is opened for controlling terminal setup. Parallel fix to the slave() method fix in 1.24. * PR #74 - Fix Perl 5.40+ "Possible memory corruption: ioctl overflowed 3rd argument" warning in clone_winsize_from() and get_winsize(). Use pack_winsize(0,0,0,0) to pre-allocate the ioctl buffer with SvCUR matching sizeof(struct winsize) instead of an empty string. * PR #76, PR #79 - Fix diagnostic warnings being silently suppressed when callers use lexical "use warnings" (the modern standard since Perl 5.6). $^W and PL_dowarn only fire under perl -w; replaced with warnings::enabled() in IO::Tty and IO::Pty (PR #76) and ckWARN(WARN_IO) in Tty.xs (PR #79). * PR #77 - Fix file descriptor leak in IO::Pty when new_from_fd() fails after pty_allocate() or _open_tty() returns raw C-level fds. Added POSIX::close() calls on the raw fds before croaking at three sites in new() and slave(). * PR #78 - Fix openpty() detection on Alpine Linux and other musl-based systems where openpty() has moved from libutil into libc (glibc 2.34+). Probe libc first before falling back to -lutil. * PR #80 - Fix -Wsign-compare compiler warnings: change namebuflen parameter type from int to size_t in open_slave() and allocate_pty() to match the return type of strlcpy() and the size argument of snprintf(). * PR #81 - Fix spurious "_FORTIFY_SOURCE requires compiling with optimization" warnings during configure probes when $Config{optimize} (e.g. -Os) is separate from $Config{ccflags}. Include optimize flags in all configure probe compilations. * PR #84 - Fix header probes in Makefile.PL missing platform extension defines (_GNU_SOURCE, _BSD_VISIBLE, etc.) that function probes already included. Bare #includes could cause HAVE_PTY_H and similar to be unset on strict POSIX systems even when the header exists. Improvements: * PR #86 - Use L<> instead of C<> for cross-module POD references in Tty.pm and Pty.pm so MetaCPAN renders IO::Pty, IO::Handle, and IO::Stty as clickable links. Maintenance: * PR #70 - Modernize POD in Tty.pm and Pty.pm: remove stale platform version references (FreeBSD 4.4, OpenBSD 2.8, HPUX 10.20, Solaris 2.6), replace defunct SourceForge/mailing list URLs with GitHub issue tracker. * PR #73 - Modernize the try example script: add strict/warnings, my declarations, 3-arg open, and lexical filehandles. The script is shipped to CPAN and referenced in POD as the canonical usage example. * PR #75 - Strengthen test coverage for set_raw() and winsize: verify all termios flags set by cfmakeraw (iflag, oflag, PARENB, CSIZE, CS8, VMIN, VTIME) and add a test for the unpack_winsize() length-validation croak. * PR #85 - Update GitHub Actions to Node.js 24 versions: actions/checkout v6, cross-platform-actions/action v1, perl-actions/install-with-cpm v2. Required before GitHub forces Node.js 24 in June 2026. 1.27 2026-04-03 Todd Rinaldo Bug Fixes: * GH #68, PR #68 - Fix build on OpenBSD by including termios.h to detect openpty reliably and setting _BSD_SOURCE to find strlcpy in includes. (Alexander Bluhm) 1.26 2026-04-02 Todd Rinaldo Bug Fixes: * PR #67 - Fix strlcpy detection on DragonFly BSD to avoid static/non-static declaration conflict. Added __DragonFly__ guard to the function test (paralleling __FreeBSD__) and added a belt-and-suspenders check for perl's own HAS_STRLCPY in Tty.xs. Maintenance: * PR #66 - Add 5-minute timeout to all CI test steps to prevent hung tests from consuming CI resources indefinitely. 1.25 2026-04-01 Todd Rinaldo Bug Fixes: * GH #62, PR #64 - Fix IO::Pty DESTROY force-closing the slave pty. The DESTROY method (added in 1.21) explicitly closed the cached slave handle, breaking consumers like IPC::Run that hold a reference to the slave via $pty->slave() and expect it to survive master destruction. Now just deletes the internal reference and lets Perl's refcounting handle fd closure correctly. Maintenance: * PR #61 - Simplify version variables to a single source of truth. Extract version from Tty.pm in Makefile.PL using MM->parse_version() instead of hardcoding it, use VERSION_FROM in WriteMakefile, and remove $XS_VERSION from Tty.pm. 1.24 2026-03-27 Todd Rinaldo Bug Fixes: * GH #54, PR #55 - Fix slave pty reopening on Solaris/illumos. After close_slave(), reopening with plain Perl open() skipped pushing STREAMS modules (ptem, ldterm, ttcompat), causing isatty() to return false. Added _open_tty() XS function that opens the device and pushes STREAMS modules on platforms that support I_PUSH. * GH #56, PR #58 - Fix undef warnings on Perl 5.8.8 by removing the undef operator on localized $SIG{__DIE__}, and fix XS ttyname() on older Perls by avoiding the InOutStream typemap which can return NULL for filehandles created via new_from_fd. * GH #57, PR #59 - Add __BSD_VISIBLE for FreeBSD in function probes. The _XOPEN_SOURCE definition hid BSD extensions like strlcpy, causing probe failures and subsequent compile errors from conflicting static/non-static declarations. Maintenance: * PR #60 - Modernize Makefile.PL: replace BUILD_REQUIRES with TEST_REQUIRES (EUMM 6.64+), add CONFIGURE_REQUIRES, upgrade META_MERGE to meta-spec v2, modernize generated Constant.pm to use 'our' instead of 'use vars', and remove dead PPD postamble. 1.23 2026-03-24 Todd Rinaldo Bug Fixes: * PR #52 - Replace deprecated indirect object syntax (e.g. `new IO::Pty`) with direct method calls (`IO::Pty->new`). Perl 5.36+ disables indirect object calls, so this fixes forward compatibility. Improvements: * PR #53 - Add clone_winsize_from() test coverage (7 new tests) covering basic clone between slave ttys, non-tty master fast path, croak on non-tty source, and pixel dimension preservation. Maintenance: * PR #52 - Regenerate README from POD to fix stale version. * PR #53 - Modernize `use vars` to `our` declarations in Tty.pm and Pty.pm. Add missing `use warnings` to Pty.pm. * Add AI_POLICY.md for transparency on AI-assisted contributions. * Convert README to Markdown and update MANIFEST. 1.22 2026-03-24 Todd Rinaldo Bug Fixes: * GH #47, PR #48 - Fix function detection on Solaris by adding __EXTENSIONS__ to expose BSD extensions (like strlcpy) that are hidden when _XOPEN_SOURCE is defined. * PR #49 - Fix file descriptor leaks in open_slave() error paths. The master pty fd was not closed on several early-return error paths, causing fd leaks when falling through multiple pty allocation methods. Improvements: * PR #50 - Add unit tests for ttyname(), slave()/close_slave() lifecycle, set_winsize()/get_winsize() round-trips, pack_winsize/unpack_winsize, and constant importing (28 new tests). * PR #51 - Replace DynaLoader with XSLoader and bump minimum perl version to 5.8.8. XSLoader is simpler and has been in core since perl 5.6. Maintenance: * PR #44 - Fix stale POD versions, add Perl 5.38/5.40 to CI, and update repository URLs from toddr/IO-Tty to cpan-authors/IO-Tty. * PR #45 - Remove dead Perl 5.003 compatibility code, modernize XS (Nullch to NULL, perl_get_sv to get_sv, sprintf to snprintf). * PR #46 - Modernize CI with dynamic perl version discovery via perl-actions/perl-versions and add a disttest job. 1.21 2026-03-22 Todd Rinaldo Bug Fixes: * GH #14, PR #39 - Fix slave fd leak on IO::Pty destruction. The slave pty file descriptor was not closed when the IO::Pty object was destroyed, leaking file descriptors until process exit. * GH #12, PR #40 - Fix set_raw() to modify cflag for proper raw mode on BSD/macOS. set_raw() was not clearing CSIZE|PARENB or setting CS8 in cflag, causing incomplete raw mode on macOS, OpenBSD, and NetBSD. * GH #38, PR #41 - Modernize function detection to use proper system headers instead of fragile K&R-style forward declarations. The old approach conflicted with real prototypes on modern compilers (especially FreeBSD/Clang), causing all function checks to fail. Improvements: * PR #42 - Add BSD CI testing for FreeBSD, OpenBSD, and NetBSD via cross-platform-actions. Also bumps actions/checkout from v2 to v4. 1.20 2023-12-28 Todd Rinaldo * #32 - Skip t/pty_get_winsize.t tests on AIX * #27 - Fix patchlevel check for util.h 1.19 2023-12-28 Todd Rinaldo * #37 - Remove --no-undefined from compiler test which is not compatible with all platforms. 1.18 2023-11-27 Todd Rinaldo * #35 - Address Freebsd build issue: Make function checks more robust within shared lib 1.17 2022-11-11 Todd Rinaldo * Switch changelog entries to metacpan friendly format * #29 - Fix printf format conversion specifiers in croak to support size_t on all platforms * #11,#30 - Tty.pm: pre-allocate buffer for ioctl but leave it length 0 * #28 - Use $arg to match @ARGV in Makefile.PL 1.16 2021-01-2 Todd Rinaldo * Switch to github for issue tracker. * Switch to testsuite CI workflow. * Tidy 1.15 2020-10-03 Todd Rinaldo * Skip winsize test on Solaris and QNX NTO * Make function tests more robust * Work around a header name collission on util.h. This is breaking on recent OSX 1.15 2020-01-18 Todd Rinaldo * Add strict/warnings to Tty.pm * Fix pod errors * Typo: s/dependend/dependent/ * Prevent spurious warning from get_winsize() * Fix usage of setsid * Github actions testing. Windows is off of course. * Make README.md 1.13_01 2014-12-14 Todd Rinaldo * RT 91590 - Remove MAP_TARGET from Makefile.PL * RT 88271 - Fix for Solaris setuid when root running as other user 1.12 2014-09-12 Todd Rinaldo * Merge pull request from Chris Williams (bingos) to fix "redefinition of typedef" errors with v5.19.4 and above 1.11 2014-05-05 Todd Rinaldo * Release 1.11 to CPAN with explicit dropping of support for Win32 (we never supported it) - RT 77813 * Bump version to a devel release 1.11_01 for experimental work. * Fix typo in compilter - RT 75649 * Add support for PERL_MM_OPT 1.10 2010-10-11 Todd Rinaldo * CPAN testers clean. Bumping to release version 1.10 1.09_01 2010-10-04 Todd Rinaldo * RT 60788 - Better error reporting on Operating Systems that can't set a controlling terminal e.g. BeOS * Bump to 1.09_01 1.09 2010-10-04 Todd Rinaldo * CPAN testers looks clean. Internal testing done on perl 5.6 * Bump version to 1.09 and release to CPAN 1.08_03 2010-10-02 Todd Rinaldo * RT 61642 - Fix file number test to work without hang on cygwin * Bump to 1.08_03 1.08_02 2010-09-10 Todd Rinaldo * Update all versions to the new version. bump to 1.08_02 1.08_01 2010-09-10 Todd Rinaldo * RT 45008 - only try TIOCSCTTY if we don't have a ctty * RT 53883 - IO::Tty detection on BeOS w/fix * RT 60014 - better META.yml by modernizing Makefile.PL * RT 44771 - Add _ to list of escape characters for compiler so it'll compile on windows This is experimental pending a successful dev release v1.08 2009-02-05 Roland Giersig * Makefile.PL, Tty.xs: added support for posix_openpt(), thanks to Ed Schouten for providing a patch v1.07 2006-07-18 Roland Giersig * Tty.xs: added some more letter to BSD allocation v1.06 2006-07-15 Roland Giersig * Tty.pm: pre-allocate buffer for ioctl v1.05 2006-06-06 Roland Giersig * Tty.xs: added includes and v1.04 2006-05-28 Roland Giersig * Tty.xs: added handling for z/OS (uses /dev/ptyp0000) * Makefile.PL: added (for HPUX) v1.03 2006-04-25 Roland Giersig * Tty.c: changed newCONSTSUB to use newSV(0) instead of PL_sv_undef, now undef'd constants work * Makefile.PL: made ccflags handling meta-char safe, added ldflags; enhanced error msg * Makefile.PL: added v1.02 2002-04-02 Roland Giersig * Tty.pm, Pty.pm: v1.02; disable warning for non-existant die handler v1.01 2002-03-18 Roland Giersig * Makefile.PL: remove cpp, test-compile instead * Tty.pm, Pty.pm: disable die handler when requiring Stty v0.97_04 2002-03-06 Roland Giersig * v0.97_04, final pre-release version v0.97_03 2002-03-04 Roland Giersig * Pty.pm: v0.97_03 * Makefile.PL: order of include files is preserved; added test for working cpp. * Tty.pm (clone_winsize_from): v0.97_03; added function. * Tty.xs (allocate_pty): fixed typo in close for _getpty; changed order of termios.h and termio.h includes 2002-02-26 Roland Giersig * test.pl: replaced Test.pm * Tty.pm (set_raw): v0.97_01; moved set_raw() from test to method * Tty.xs: got rid of snprintf; don't try openpty() and getpt() if ptsname is not there. * Pty.pm: v0.97_01; updated docs * Makefile.PL: v0.97_01; auto-create IO::Tty::Constant 2002-01-31 Roland Giersig * Pty.pm: add IO::Stty to @ISA, master pty is sometimes a tty. * Tty.pm: v0.95_01 2002-01-30 Roland Giersig * Tty.pm, Pty.pm: v0.94_05 * Tty.xs (allocate_pty): moved getpt() and openpty() before muxes * test.pl: if master isatty, set it also to raw; seems to be needed. * Makefile.PL: fixed checks; test problematic constants with a compile. 2002-01-23 Roland Giersig * Tty.pm: v0.94_03 * test.pl: changed test to probe for maximum chunk the pty can handle; also, the /dev/tty test probes if an EOF is correctly reported from the child to the parent. * Tty.xs: finally made debug printfs optional via $IO::Tty::DEBUG. 2002-01-18 Roland Giersig * Tty.pm: v0.94_02 * Tty.xs: added #include termio.h 2002-01-07 Roland Giersig * Pty.pm: adapted to new interface (close_slave): added for keeping open filecount straight (make_slave_controlling_terminal): created anew (slave): reverted from open_slave() * Tty.pm: v0.94_01 * test.pl: adapted to new interface * Tty.xs: reverted to opening slave at creation time; added debug printfs (open_slave): use ptsname_r if there, forget about erroneous ttyname. (allocate_pty): added name param on openpty (doesn't take NULL for name) 2001-11-28 Roland Giersig * Tty.pm: v0.92_04 * Tty.xs (BOOT): use perl_get_sv for backward compat * Makefile.PL: added analysis of configuration 2001-11-27 Roland Giersig * Tty.pm: v0.92_03 * Tty.xs (BOOT): removed export_fail, undefined constants are now undef instead of not exportable; added CONFIG variable. * Makefile.PL: added setting of CONFIG var * test.pl: added printing of CONFIG var * Pty.pm (spawn): fixed bug with $^W handling 2001-11-17 Roland Giersig * Tty.xs (pty_allocate): complete rewrite, based on ideas from openssh and Xemacs. Tries all ways detected by Makefile.PL in order, so in theory it should work everywhere (modulo system quirks). First tries the high-level openpty() before getpt(), then various clone devices and finally BSD-style ptys. * Tty.xs (open_slave): moved master init stuff here, must be done before opening the slave. The Stream module pushes are now tried on all systems but only generate warnings on systems that we know need them. * Makefile.PL: added tests for all kinds of functions and clone devices. 2001-11-14 Roland Giersig * Tty.xs (MODULE): stole creation code from openssh * test.pl: added test for controlling terminal * Pty.pm (spawn): rearranged setsid() and added a fresh open of the slave pty so the pty becomes the controlling terminal for the process. 2001-10-25 Roland Giersig * Pty.pm (spawn): copied spawning process from Tcl/Expect (thanks, Don!); should set the controlling tty so ssh and other password requesting programs should be OK; also now returns exec errors. (slave_pid): added method to get at PID of spawned process. * Makefile.PL: added TIOCCONS. * try: adapted to use spawn(). * test.pl: adapted to use spawn(); added test for exec errors. 2001-10-16 Roland Giersig * Pty.pm (new): fixed bad my() line * automatically add IO::Stty to ISA if it exists. 2001-07-16 Roland Giersig * test.pl: finally some tests! Spawns a perl mini-script that echoes back all characters from STDIN, but inverted. * Pty.pm (slave): slave now is set to be a controlling tty if possible; it also remembers it's name now. * Makefile.PL: - on SCO, the slave pts* are in the /dev dir, not /dev/pts - added test for libutil.h, util.h, pty.h and openpty() - added symbol TIOCSCTTY * Tty.xs: - some SVR4 only define __SVR4; fixed. - OSF machines need termio.h for various macros - AIX doesn't define VOIDSIG; fixed. - Cygwin can use /dev/ptmx even though that file doesn't exist. - added openpty() version for FreeBSD and others that have no good method for creating ptys; untested. * Tty.pm: - moved docu over from Pty.pm to lessen confusion Pty <-> Tty - added verified systems list Change 588 on 2000/09/04 by (Graham Barr) Check for /dev/ptmx and /dev/pts instead of testing defined(SVR4) Change 587 on 2000/09/04 by (Graham Barr) Make ttyname just warn when it is not implemented instead of croak Change 586 on 2000/09/04 by (Graham Barr) Include for HPUX Change 585 on 2000/09/04 by (Graham Barr) Makefile.PL - Fix to how cc is called Change 461 on 2000/03/29 by (Graham Barr) Release 0.03 Change 460 on 2000/03/29 by (Graham Barr) General cleanup and added PPD stuff into Makefile.PL Change 310 on 1999/05/10 by (Graham Barr) - Removed the need for Configure by implementing a test in Makefile.PL - The existance of constants are now checked at import time, so @EXPORT had to be renamed to @EXPORT_OK. ie noting is imported by default IO-Tty-1.28/Tty.xs000644 000765 000024 00000060170 15172366073 014162 0ustar00toddrstaff000000 000000 #include "EXTERN.h" #include "perl.h" #include "XSUB.h" #define PTY_DEBUG 1 #ifdef PTY_DEBUG static int print_debug; #endif #ifdef PerlIO typedef int SysRet; typedef PerlIO * InOutStream; #else # define PERLIO_IS_STDIO 1 # define PerlIO_fileno fileno typedef int SysRet; typedef FILE * InOutStream; #endif #include "patchlevel.h" /* * The following pty-allocation code was heavily inspired by its * counterparts in openssh 3.0p1 and Xemacs 21.4.5 but is a complete * rewrite by me, Roland Giersig . * * Nevertheless my references to Tatu Ylonen * and the Xemacs development team for their inspiring code. * * mysignal and strlcpy were borrowed from openssh and have their * copyright messages attached. */ #include #include #include #include #include #include #include #ifdef HAVE_LIBUTIL_H # include #endif /* HAVE_UTIL_H */ #ifdef HAVE_UTIL_H # ifdef UTIL_H_ABS_PATH # include UTIL_H_ABS_PATH # elif ((PATCHLEVEL < 19) || ((PATCHLEVEL == 19) && (SUBVERSION < 4))) # include # endif #endif /* HAVE_UTIL_H */ #ifdef HAVE_PTY_H # include #endif #ifdef HAVE_SYS_PTY_H # include #endif #ifdef HAVE_SYS_PTYIO_H # include #endif #if defined(HAVE_DEV_PTMX) && defined(HAVE_SYS_STROPTS_H) # include #endif #ifdef HAVE_TERMIOS_H #include #endif #ifdef HAVE_TERMIO_H #include #endif #ifndef O_NOCTTY #define O_NOCTTY 0 #endif /* from $OpenBSD: misc.c,v 1.12 2001/06/26 17:27:24 markus Exp $ */ /* * Copyright (c) 2000 Markus Friedl. All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * * THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES * OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. * IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, * INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT * NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, * DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY * THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT * (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF * THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #include typedef void (*mysig_t)(int); static mysig_t mysignal(int sig, mysig_t act) { #ifdef HAVE_SIGACTION struct sigaction sa, osa; if (sigaction(sig, NULL, &osa) == -1) return (mysig_t) -1; if (osa.sa_handler != act) { memset(&sa, 0, sizeof(sa)); sigemptyset(&sa.sa_mask); sa.sa_flags = 0; #if defined(SA_INTERRUPT) if (sig == SIGALRM) sa.sa_flags |= SA_INTERRUPT; #endif sa.sa_handler = act; if (sigaction(sig, &sa, NULL) == -1) return (mysig_t) -1; } return (osa.sa_handler); #else return (signal(sig, act)); #endif } /* from $OpenBSD: strlcpy.c,v 1.5 2001/05/13 15:40:16 deraadt Exp $ */ /* * Copyright (c) 1998 Todd C. Miller * All rights reserved. * * Redistribution and use in source and binary forms, with or without * modification, are permitted provided that the following conditions * are met: * 1. Redistributions of source code must retain the above copyright * notice, this list of conditions and the following disclaimer. * 2. Redistributions in binary form must reproduce the above copyright * notice, this list of conditions and the following disclaimer in the * documentation and/or other materials provided with the distribution. * 3. The name of the author may not be used to endorse or promote products * derived from this software without specific prior written permission. * * THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, * INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY * AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL * THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, * EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, * PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; * OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR * OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF * ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. */ #if !defined(HAVE_STRLCPY) && !defined(HAS_STRLCPY) /* * Copy src to string dst of size siz. At most siz-1 characters * will be copied. Always NUL terminates (unless siz == 0). * Returns strlen(src); if retval >= siz, truncation occurred. */ static size_t strlcpy(char *dst, const char *src, size_t siz) { register char *d = dst; register const char *s = src; register size_t n = siz; /* Copy as many bytes as will fit */ if (n != 0 && --n != 0) { do { if ((*d++ = *s++) == 0) break; } while (--n != 0); } /* Not enough room in dst, add NUL and traverse rest of src */ if (n == 0) { if (siz != 0) *d = '\0'; /* NUL-terminate dst */ while (*s++) ; } return(s - src - 1); /* count does not include NUL */ } #endif /* !HAVE_STRLCPY && !HAS_STRLCPY */ /* * Move file descriptor so it doesn't collide with stdin/out/err */ static void make_safe_fd(int * fd) { if (*fd < 3) { int newfd; newfd = fcntl(*fd, F_DUPFD, 3); if (newfd < 0) { if (ckWARN(WARN_IO)) warn("IO::Tty::pty_allocate(nonfatal): tried to move fd %d up but fcntl() said %.100s", *fd, strerror(errno)); } else { close (*fd); *fd = newfd; } } } /* * After having acquired a master pty, try to find out the slave name, * initialize and open the slave. */ #if defined (HAVE_PTSNAME) char * ptsname(int); #endif static int open_slave(int *ptyfd, int *ttyfd, char *namebuf, size_t namebuflen) { /* * now do some things that are supposedly healthy for ptys, * i.e. changing the access mode. */ #if defined(HAVE_GRANTPT) || defined(HAVE_UNLOCKPT) { mysig_t old_signal; old_signal = mysignal(SIGCHLD, SIG_DFL); #if defined(HAVE_GRANTPT) #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying grantpt()...\n"); #endif if (grantpt(*ptyfd) < 0) { if (ckWARN(WARN_IO)) warn("IO::Tty::pty_allocate(nonfatal): grantpt(): %.100s", strerror(errno)); } #endif /* HAVE_GRANTPT */ #if defined(HAVE_UNLOCKPT) #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying unlockpt()...\n"); #endif if (unlockpt(*ptyfd) < 0) { if (ckWARN(WARN_IO)) warn("IO::Tty::pty_allocate(nonfatal): unlockpt(): %.100s", strerror(errno)); } #endif /* HAVE_UNLOCKPT */ mysignal(SIGCHLD, old_signal); } #endif /* HAVE_GRANTPT || HAVE_UNLOCKPT */ /* * find the slave name, if we don't have it already */ #if defined (HAVE_PTSNAME_R) if (namebuf[0] == 0) { #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying ptsname_r()...\n"); #endif if(ptsname_r(*ptyfd, namebuf, namebuflen)) { if (ckWARN(WARN_IO)) warn("IO::Tty::open_slave(nonfatal): ptsname_r(): %.100s", strerror(errno)); } } #endif /* HAVE_PTSNAME_R */ #if defined (HAVE_PTSNAME) if (namebuf[0] == 0) { char * name; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying ptsname()...\n"); #endif name = ptsname(*ptyfd); if (name) { if(strlcpy(namebuf, name, namebuflen) >= namebuflen) { warn("ERROR: IO::Tty::open_slave: ttyname truncated"); close(*ptyfd); *ptyfd = -1; return 0; } } else { if (ckWARN(WARN_IO)) warn("IO::Tty::open_slave(nonfatal): ptsname(): %.100s", strerror(errno)); } } #endif /* HAVE_PTSNAME */ if (namebuf[0] == 0) { close(*ptyfd); *ptyfd = -1; return 0; /* we failed to get the slave name */ } #if defined (__SVR4) && defined (__sun) #include #include { uid_t euid = geteuid(); uid_t uid = getuid(); /* root running as another user * grantpt() has done the wrong thing */ if (euid != uid && uid == 0) { #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying seteuid() from %d to %d...\n", euid, uid); #endif if (setuid(uid)) { warn("ERROR: IO::Tty::open_slave: couldn't seteuid to root: %d", errno); close(*ptyfd); *ptyfd = -1; return 0; } if (chown(namebuf, euid, -1)) { warn("ERROR: IO::Tty::open_slave: couldn't fchown the pty: %d", errno); close(*ptyfd); *ptyfd = -1; return 0; } if (seteuid(euid)) { warn("ERROR: IO::Tty::open_slave: couldn't seteuid back: %d", errno); close(*ptyfd); *ptyfd = -1; return 0; } } } #endif if (*ttyfd >= 0) { make_safe_fd(ptyfd); make_safe_fd(ttyfd); return 1; /* we already have an open slave, so no more init is needed */ } /* * Open the slave side. */ #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying to open %s...\n", namebuf); #endif *ttyfd = open(namebuf, O_RDWR | O_NOCTTY); if (*ttyfd < 0) { if (ckWARN(WARN_IO)) warn("IO::Tty::open_slave(nonfatal): open(%.200s): %.100s", namebuf, strerror(errno)); close(*ptyfd); *ptyfd = -1; return 0; /* too bad, couldn't open slave side */ } #if defined (I_PUSH) /* * Push appropriate streams modules for Solaris pty(7). * HP-UX pty(7) doesn't have ttcompat module. * We simply try to push all relevant modules but warn only on * those platforms we know these are required. */ #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying to I_PUSH ptem...\n"); #endif if (ioctl(*ttyfd, I_PUSH, "ptem") < 0) #if defined (__solaris) || defined(__hpux) if (ckWARN(WARN_IO)) warn("IO::Tty::pty_allocate: ioctl I_PUSH ptem: %.100s", strerror(errno)) #endif ; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying to I_PUSH ldterm...\n"); #endif if (ioctl(*ttyfd, I_PUSH, "ldterm") < 0) #if defined (__solaris) || defined(__hpux) if (ckWARN(WARN_IO)) warn("IO::Tty::pty_allocate: ioctl I_PUSH ldterm: %.100s", strerror(errno)) #endif ; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying to I_PUSH ttcompat...\n"); #endif if (ioctl(*ttyfd, I_PUSH, "ttcompat") < 0) #if defined (__solaris) if (ckWARN(WARN_IO)) warn("IO::Tty::pty_allocate: ioctl I_PUSH ttcompat: %.100s", strerror(errno)) #endif ; #endif /* I_PUSH */ /* finally we make sure the filedescriptors are > 2 to avoid problems with stdin/out/err. This can happen if the user closes one of them before allocating a pty and leads to nasty side-effects, so we take a proactive stance here. Normally I would say "Those who mess with stdin/out/err shall bear the consequences to the fullest" but hey, I'm a nice guy... ;O) */ make_safe_fd(ptyfd); make_safe_fd(ttyfd); return 1; } /* * Allocates and opens a pty. Returns 0 if no pty could be allocated, or * nonzero if a pty was successfully allocated. On success, open file * descriptors for the pty and tty sides and the name of the tty side are * returned (the buffer must be able to hold at least 64 characters). * * Instead of trying just one method we go through all available * methods until we get a positive result. */ static int allocate_pty(int *ptyfd, int *ttyfd, char *namebuf, size_t namebuflen) { *ptyfd = -1; *ttyfd = -1; namebuf[0] = 0; /* * first we try to get a master device */ do { /* we use do{}while(0) and break instead of goto */ #if defined(HAVE__GETPTY) /* _getpty(3) for SGI Irix */ { char *slave; mysig_t old_signal; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying _getpty()...\n"); #endif /* _getpty spawns a suid prog, so don't ignore SIGCHLD */ old_signal = mysignal(SIGCHLD, SIG_DFL); slave = _getpty(ptyfd, O_RDWR, 0622, 0); mysignal(SIGCHLD, old_signal); if (slave != NULL) { if (strlcpy(namebuf, slave, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); close(*ptyfd); *ptyfd = -1; return 0; } if (open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; /* open_slave closes *ptyfd on failure */ } else { if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): _getpty(): %.100s", strerror(errno)); *ptyfd = -1; } } #endif #if defined(HAVE_PTSNAME) || defined(HAVE_PTSNAME_R) /* we don't need to try these if we don't have a way to get the pty names */ #if defined(HAVE_POSIX_OPENPT) #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying posix_openpt()...\n"); #endif *ptyfd = posix_openpt(O_RDWR|O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; /* got one */ if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): posix_openpt(): %.100s", strerror(errno)); #endif /* defined(HAVE_POSIX_OPENPT) */ #if defined(HAVE_GETPT) /* glibc defines this */ #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying getpt()...\n"); #endif *ptyfd = getpt(); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; /* got one */ if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): getpt(): %.100s", strerror(errno)); #endif /* defined(HAVE_GETPT) */ #if defined(HAVE_OPENPTY) /* openpty(3) exists in a variety of OS'es, but due to it's * broken interface (no maxlen to slavename) we'll only use it * to create the tty/pty pair and rely on ptsname to get the * name. */ { mysig_t old_signal; int ret; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying openpty()...\n"); #endif old_signal = mysignal(SIGCHLD, SIG_DFL); ret = openpty(ptyfd, ttyfd, NULL, NULL, NULL); mysignal(SIGCHLD, old_signal); if (ret >= 0 && *ptyfd >= 0) { if (open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; /* open_slave closes *ptyfd on failure; close *ttyfd which openpty() opened */ if (*ttyfd >= 0) { close(*ttyfd); *ttyfd = -1; } } else { *ptyfd = -1; *ttyfd = -1; } if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): openpty(): %.100s", strerror(errno)); } #endif /* defined(HAVE_OPENPTY) */ /* * now try various cloning devices */ #if defined(HAVE_DEV_PTMX) #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying /dev/ptmx...\n"); #endif *ptyfd = open("/dev/ptmx", O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): open(/dev/ptmx): %.100s", strerror(errno)); #endif /* HAVE_DEV_PTMX */ #if defined(HAVE_DEV_PTYM_CLONE) #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying /dev/ptym/clone...\n"); #endif *ptyfd = open("/dev/ptym/clone", O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): open(/dev/ptym/clone): %.100s", strerror(errno)); #endif /* HAVE_DEV_PTYM_CLONE */ #if defined(HAVE_DEV_PTC) /* AIX-style pty code. */ #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying /dev/ptc...\n"); #endif *ptyfd = open("/dev/ptc", O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): open(/dev/ptc): %.100s", strerror(errno)); #endif /* HAVE_DEV_PTC */ #if defined(HAVE_DEV_PTMX_BSD) #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying /dev/ptmx_bsd...\n"); #endif *ptyfd = open("/dev/ptmx_bsd", O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; if (ckWARN(WARN_IO)) warn("pty_allocate(nonfatal): open(/dev/ptmx_bsd): %.100s", strerror(errno)); #endif /* HAVE_DEV_PTMX_BSD */ #endif /* !defined(HAVE_PTSNAME) && !defined(HAVE_PTSNAME_R) */ /* * we still don't have a pty, so try some oldfashioned stuff, * looking for a pty/tty pair ourself. */ #if defined(_CRAY) { char buf[64]; int i; int highpty; #ifdef _SC_CRAY_NPTY highpty = sysconf(_SC_CRAY_NPTY); if (highpty == -1) highpty = 128; #else highpty = 128; #endif #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying CRAY /dev/pty/???...\n"); #endif for (i = 0; i < highpty; i++) { snprintf(buf, sizeof(buf), "/dev/pty/%03d", i); *ptyfd = open(buf, O_RDWR | O_NOCTTY); if (*ptyfd < 0) continue; snprintf(buf, sizeof(buf), "/dev/ttyp%03d", i); if (strlcpy(namebuf, buf, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); close(*ptyfd); *ptyfd = -1; return 0; } break; } if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; } #endif #if defined(HAVE_DEV_PTYM) { /* HPUX */ char buf[64]; char tbuf[64]; int i; struct stat sb; const char *ptymajors = "abcefghijklmnopqrstuvwxyz"; const char *ptyminors = "0123456789abcdef"; int num_minors = strlen(ptyminors); int num_ptys = strlen(ptymajors) * num_minors; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying HPUX /dev/ptym/pty[a-ce-z][0-9a-f]...\n"); #endif /* try /dev/ptym/pty[a-ce-z][0-9a-f] */ for (i = 0; i < num_ptys; i++) { snprintf(buf, sizeof(buf), "/dev/ptym/pty%c%c", ptymajors[i / num_minors], ptyminors[i % num_minors]); snprintf(tbuf, sizeof(tbuf), "/dev/pty/tty%c%c", ptymajors[i / num_minors], ptyminors[i % num_minors]); if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); return 0; } if(stat(buf, &sb)) break; /* file does not exist, skip rest */ *ptyfd = open(buf, O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; namebuf[0] = 0; } if (*ptyfd >= 0) break; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying HPUX /dev/ptym/pty[a-ce-z][0-9][0-9]...\n"); #endif /* now try /dev/ptym/pty[a-ce-z][0-9][0-9] */ num_minors = 100; num_ptys = strlen(ptymajors) * num_minors; for (i = 0; i < num_ptys; i++) { snprintf(buf, sizeof(buf), "/dev/ptym/pty%c%02d", ptymajors[i / num_minors], i % num_minors); snprintf(tbuf, sizeof(tbuf), "/dev/pty/tty%c%02d", ptymajors[i / num_minors], i % num_minors); if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); return 0; } if(stat(buf, &sb)) break; /* file does not exist, skip rest */ *ptyfd = open(buf, O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; namebuf[0] = 0; } if (*ptyfd >= 0) break; } #endif /* HAVE_DEV_PTYM */ { /* BSD-style pty code. */ char buf[64]; char tbuf[64]; int i; const char *ptymajors = "pqrstuvwxyzabcdefghijklmnoABCDEFGHIJKLMNOPQRSTUVWXYZ"; const char *ptyminors = "0123456789abcdefghijklmnopqrstuv"; int num_minors = strlen(ptyminors); int num_ptys = strlen(ptymajors) * num_minors; #if PTY_DEBUG if (print_debug) fprintf(stderr, "trying BSD /dev/pty??...\n"); #endif for (i = 0; i < num_ptys; i++) { snprintf(buf, sizeof(buf), "/dev/pty%c%c", ptymajors[i / num_minors], ptyminors[i % num_minors]); snprintf(tbuf, sizeof(tbuf), "/dev/tty%c%c", ptymajors[i / num_minors], ptyminors[i % num_minors]); if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); return 0; } *ptyfd = open(buf, O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; /* Try SCO style naming */ snprintf(buf, sizeof(buf), "/dev/ptyp%d", i); snprintf(tbuf, sizeof(tbuf), "/dev/ttyp%d", i); if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); return 0; } *ptyfd = open(buf, O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; /* Try BeOS style naming */ snprintf(buf, sizeof(buf), "/dev/pt/%c%c", ptymajors[i / num_minors], ptyminors[i % num_minors]); snprintf(tbuf, sizeof(tbuf), "/dev/tt/%c%c", ptymajors[i / num_minors], ptyminors[i % num_minors]); if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); return 0; } *ptyfd = open(buf, O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; /* Try z/OS style naming */ snprintf(buf, sizeof(buf), "/dev/ptyp%04d", i); snprintf(tbuf, sizeof(tbuf), "/dev/ttyp%04d", i); if (strlcpy(namebuf, tbuf, namebuflen) >= namebuflen) { warn("ERROR: pty_allocate: ttyname truncated"); return 0; } *ptyfd = open(buf, O_RDWR | O_NOCTTY); if (*ptyfd >= 0 && open_slave(ptyfd, ttyfd, namebuf, namebuflen)) break; namebuf[0] = 0; } if (*ptyfd >= 0) break; } } while (0); if (*ptyfd < 0 || namebuf[0] == 0) return 0; /* we failed to allocate one */ return 1; /* whew, finally finished successfully */ } /* end allocate_pty */ MODULE = IO::Tty PACKAGE = IO::Pty PROTOTYPES: DISABLE void pty_allocate() INIT: int ptyfd, ttyfd, ret; char name[256]; #ifdef PTY_DEBUG SV *debug; #endif PPCODE: #ifdef PTY_DEBUG debug = get_sv("IO::Tty::DEBUG", FALSE); if (SvTRUE(debug)) print_debug = 1; #endif ret = allocate_pty(&ptyfd, &ttyfd, name, sizeof(name)); if (ret) { name[sizeof(name)-1] = 0; EXTEND(SP,3); PUSHs(sv_2mortal(newSViv(ptyfd))); PUSHs(sv_2mortal(newSViv(ttyfd))); PUSHs(sv_2mortal(newSVpv(name, strlen(name)))); } else { /* empty list */ } MODULE = IO::Tty PACKAGE = IO::Tty int _open_tty(ttyname) char *ttyname CODE: RETVAL = open(ttyname, O_RDWR | O_NOCTTY); if (RETVAL >= 0) { #if defined(I_PUSH) ioctl(RETVAL, I_PUSH, "ptem"); ioctl(RETVAL, I_PUSH, "ldterm"); ioctl(RETVAL, I_PUSH, "ttcompat"); #endif } OUTPUT: RETVAL char * ttyname(fh) SV * fh CODE: #ifdef HAVE_TTYNAME { IO *io = sv_2io(fh); PerlIO *f = io ? IoIFP(io) : NULL; if (!f && io) f = IoOFP(io); if (f) RETVAL = ttyname(PerlIO_fileno(f)); else { RETVAL = NULL; errno = EINVAL; } } #else warn("IO::Tty::ttyname not implemented on this architecture"); RETVAL = NULL; #endif OUTPUT: RETVAL SV * pack_winsize(row, col, xpixel = 0, ypixel = 0) int row int col int xpixel int ypixel INIT: struct winsize ws; CODE: ws.ws_row = row; ws.ws_col = col; ws.ws_xpixel = xpixel; ws.ws_ypixel = ypixel; RETVAL = newSVpvn((char *)&ws, sizeof(ws)); OUTPUT: RETVAL void unpack_winsize(winsize) SV *winsize; INIT: struct winsize ws; PPCODE: if(SvCUR(winsize) != sizeof(ws)) croak("IO::Tty::unpack_winsize(): Bad arg length - got %zd, expected %zd", SvCUR(winsize), sizeof(ws)); Copy(SvPV_nolen(winsize), &ws, sizeof(ws), char); EXTEND(SP, 4); PUSHs(sv_2mortal(newSViv(ws.ws_row))); PUSHs(sv_2mortal(newSViv(ws.ws_col))); PUSHs(sv_2mortal(newSViv(ws.ws_xpixel))); PUSHs(sv_2mortal(newSViv(ws.ws_ypixel))); BOOT: { HV *stash; SV *config; stash = gv_stashpv("IO::Tty::Constant", TRUE); config = get_sv("IO::Tty::CONFIG", TRUE); #include "xssubs.c" } IO-Tty-1.28/MANIFEST000644 000765 000024 00000000631 15172373622 014151 0ustar00toddrstaff000000 000000 AI_POLICY.md ChangeLog Makefile.PL MANIFEST This list of files MANIFEST.SKIP Pty.pm README.md t/clone_winsize.t t/constants.t t/pty_destroy.t t/pty_get_winsize.t t/pty_set_raw.t t/slave.t t/test.t t/ttyname.t t/winsize.t try Tty.pm Tty.xs META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) IO-Tty-1.28/PaxHeader/AI_POLICY.md000644 000765 000024 00000000333 15160625242 016655 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/AI_POLICY.md000644 000765 000024 00000013036 15160625242 014710 0ustar00toddrstaff000000 000000 # AI Policy > **TL;DR** — AI tools assist our workflow at every stage. Humans remain in control of every decision, every review, and every release. --- ## Overview This document describes how artificial intelligence tools are used in the maintenance and development of this project. It is intended to be transparent with our contributors, users, and the broader open-source community about the role AI plays — and, equally importantly, the role it does **not** play. We believe in honest, clear communication about AI-assisted workflows. This policy will be updated as our practices evolve. --- ## Our Guiding Principle **AI assists. Humans decide.** The maintainers who have been stewarding this project for years remain fully responsible for every line of code that ships. AI tools extend our capacity to review, research, and improve — they do not replace human judgment, expertise, or accountability. --- ## How AI Is Used in This Project ### 1. Code and Issue Analysis AI tools help us process and understand incoming issues, pull requests, and code changes at scale. This includes: - Summarising issue reports and identifying patterns across similar bugs - Analysing code diffs for potential problems, regressions, or style inconsistencies - Surfacing relevant context from the codebase, documentation, and prior discussions - Flagging potential security concerns for human review This analysis is **always** used as input to human decision-making, never as a substitute for it. ### 2. Draft Pull Requests AI may generate draft pull requests as a starting point for a fix, a refactor, or an improvement. These drafts: - Are clearly labelled as AI-generated when created - Represent a first pass only — they are never considered complete or correct without human review - May be substantially reworked, rejected, or replaced entirely by maintainers Think of these drafts the way you would think of a junior contributor's first attempt: useful raw material that still needs experienced eyes. ### 3. Human Review of Every Pull Request **Every pull request — whether AI-drafted or human-authored — is reviewed by a human maintainer before it can be merged.** During review, maintainers actively use AI as a tool to assist their own thinking: - Asking AI to explain or justify specific implementation choices - Challenging AI-generated code and requesting alternative approaches - Using AI to research edge cases, relevant standards, or upstream behaviour - Requesting targeted rewrites of individual sections based on review feedback The maintainer's judgment always takes precedence. AI answers are treated as input to be verified, not conclusions to be accepted. ### 4. Test Coverage and Defect Detection AI helps us improve the quality and completeness of our test suite by: - Suggesting test cases for edge conditions and failure modes - Identifying gaps in existing test coverage - Proposing tests that target known classes of defects or security issues - Helping reproduce and characterise reported bugs All suggested tests are reviewed and validated by maintainers before being committed. ### 5. Security Review AI tools assist in identifying potential security issues, including: - Common vulnerability patterns (injection, insecure defaults, deprecated APIs, etc.) - Dependencies with known CVEs - Code paths that may warrant closer scrutiny Security findings from AI are **always** verified by a human maintainer. We do not act on AI-flagged security issues without independent assessment. --- ## What AI Does Not Do To be explicit about the limits of AI involvement in this project: | ❌ AI does not… | ✅ A human maintainer does… | |---|---| | Approve or merge pull requests | Review and decide on every PR | | Make architectural decisions | Own all design and direction choices | | Triage and close issues autonomously | Assess and respond to all issues | | Publish releases | Tag, build, and release manually | | Represent the project publicly | Communicate on behalf of the project | --- ## Releases Releases are performed manually by the same long-standing maintainers as always. The release process — including changelog review, version tagging, and publication — uses standard Perl ecosystem tooling (e.g. ExtUtils::MakeMaker, Dist::Zilla, Module::Build) but involves no AI-driven automation. Every release is initiated, supervised, and published by a human maintainer. AI may assist in drafting changelogs or release notes, but these are always reviewed and edited before publication. --- ## Attribution and Transparency Where AI has played a material role in generating code or content within a pull request, we aim to note this in the PR description (e.g. via a `Generated-By` or `AI-Assisted` label or note). We do not consider AI the author of any contribution — the maintainer who reviewed and approved the work takes responsibility for it. --- ## Why We Do This Open-source software is built on trust. Our users and downstream dependants trust us to ship correct, secure, and well-considered code. AI tools help us do that work better — but they do not change who is responsible for the outcome. We use AI because it makes our maintainers more effective, not because it replaces them. --- ## Questions and Feedback If you have questions about our use of AI, or concerns about a specific pull request or change, please open an issue or start a discussion. We are committed to being open about our process. --- *Last updated: 2026-03-23* *This policy is maintained by the project maintainers and subject to revision as AI tooling and community norms evolve.* IO-Tty-1.28/t/000755 000765 000024 00000000000 15172373621 013262 5ustar00toddrstaff000000 000000 IO-Tty-1.28/PaxHeader/README.md000644 000765 000024 00000000543 15172373476 016261 xustar00toddrstaff000000 000000 30 mtime=1776940862.809850312 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 57 LIBARCHIVE.xattr.com.apple.provenance=AQIAgoHgHCklCGI 49 SCHILY.xattr.com.apple.provenance=)%b IO-Tty-1.28/README.md000644 000765 000024 00000010377 15172373476 014316 0ustar00toddrstaff000000 000000 [![testsuite](https://github.com/cpan-authors/IO-Tty/actions/workflows/testsuite.yml/badge.svg)](https://github.com/cpan-authors/IO-Tty/actions/workflows/testsuite.yml) # NAME IO::Tty - Low-level allocate a pseudo-Tty, import constants. # VERSION 1.28 # SYNOPSIS use IO::Tty qw(TIOCNOTTY); ... # use only to import constants, see IO::Pty to create ptys. # DESCRIPTION `IO::Tty` is used internally by [IO::Pty](https://metacpan.org/pod/IO%3A%3APty) to create a pseudo-tty. You wouldn't want to use it directly except to import constants, use [IO::Pty](https://metacpan.org/pod/IO%3A%3APty). For a list of importable constants, see [IO::Tty::Constant](https://metacpan.org/pod/IO%3A%3ATty%3A%3AConstant). Windows is now supported under the Cygwin environment, see [http://cygwin.com/](http://cygwin.com/). Please note that pty creation is very system-dependent. Any modern POSIX system should be fine. The test suite is run via GitHub Actions CI on Linux, macOS, FreeBSD, OpenBSD, and NetBSD. If you have problems on your system and it is listed below, you probably have a non-standard setup, e.g. you compiled your Linux-kernel yourself and disabled ptys (bummer!). Please ask your friendly sysadmin for help. If your system is not listed, unpack the latest version of `IO::Tty`, do a `'perl Makefile.PL; make; make test; uname -a'` and report issues at [https://github.com/cpan-authors/IO-Tty/issues](https://github.com/cpan-authors/IO-Tty/issues). # PLATFORMS AND KNOWN ISSUES `IO::Tty` is tested via CI on Linux, macOS, FreeBSD, OpenBSD, and NetBSD across multiple Perl versions. It is also known to work on AIX, Solaris/illumos, HP-UX, IRIX, z/OS, and Windows (under Cygwin). Known platform-specific behaviors: - Linux, AIX Returns EIO instead of EOF when the slave is closed. Benign. - FreeBSD, OpenBSD, HP-UX, Solaris EOF on the slave tty is not reported back to the master. - OpenBSD The ioctl TIOCSCTTY sometimes fails. This is also known in Tcl/Expect. - Solaris Has the "feature" of returning EOF just once. - Cygwin When you send (print) a too long line (>160 chars) to a non-raw pty, the call just hangs forever and even alarm() cannot get you out. Please report issues at [https://github.com/cpan-authors/IO-Tty/issues](https://github.com/cpan-authors/IO-Tty/issues). # SEE ALSO [IO::Pty](https://metacpan.org/pod/IO%3A%3APty), [IO::Tty::Constant](https://metacpan.org/pod/IO%3A%3ATty%3A%3AConstant) Source code and issue tracker at [https://github.com/cpan-authors/IO-Tty](https://github.com/cpan-authors/IO-Tty). # AUTHORS Originally by Graham Barr <`gbarr@pobox.com`>, based on the Ptty module by Nick Ing-Simmons <`nik@tiuk.ti.com`>. Heavily rewritten by Roland Giersig <`RGiersig@cpan.org`>. Currently maintained by Todd Rinaldo. Contains copyrighted stuff from openssh v3.0p1, authored by Tatu Ylonen , Markus Friedl and Todd C. Miller . # COPYRIGHT Now all code is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Nevertheless the above AUTHORS retain their copyrights to the various parts and want to receive credit if their source code is used. See the source for details. # DISCLAIMER THIS SOFTWARE IS PROVIDED \`\`AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. In other words: Use at your own risk. Provided as is. Your mileage may vary. Read the source, Luke! And finally, just to be sure: Any Use of This Product, in Any Manner Whatsoever, Will Increase the Amount of Disorder in the Universe. Although No Liability Is Implied Herein, the Consumer Is Warned That This Process Will Ultimately Lead to the Heat Death of the Universe. IO-Tty-1.28/MANIFEST.SKIP000644 000765 000024 00000000225 15172366116 014715 0ustar00toddrstaff000000 000000 ^.github/ ^.git/.* ^MYMETA.* ^MANIFEST.bak ^.gitignore ^conf/ ^xssubs.c ^Tty/Constant.pm ^Makefile$ ^IO-Tty-\d ^IO-Tty\.ppd$ ^cpanfile$ ^CLAUDE\.md$ IO-Tty-1.28/PaxHeader/Pty.pm000644 000765 000024 00000000210 15172373467 016103 xustar00toddrstaff000000 000000 30 mtime=1776940855.821445819 57 LIBARCHIVE.xattr.com.apple.provenance=AQIAgoHgHCklCGI 49 SCHILY.xattr.com.apple.provenance=)%b IO-Tty-1.28/Pty.pm000644 000765 000024 00000024021 15172373467 014140 0ustar00toddrstaff000000 000000 # Documentation at the __END__ package IO::Pty; use strict; use warnings; use Carp; use IO::Tty qw(TIOCSCTTY TCSETCTTY TIOCNOTTY); use IO::File; require POSIX; our @ISA = qw(IO::Handle); our $VERSION = '1.28'; # keep same as in Tty.pm eval { local $^W = 0; local $SIG{__DIE__}; require IO::Stty }; push @ISA, "IO::Stty" if ( not $@ ); # if IO::Stty is installed sub new { my ($class) = $_[0] || "IO::Pty"; $class = ref($class) if ref($class); @_ <= 1 or croak 'usage: new $class'; my ( $ptyfd, $ttyfd, $ttyname ) = pty_allocate(); croak "Cannot open a pty" if not defined $ptyfd; my $pty = $class->SUPER::new_from_fd( $ptyfd, "r+" ); if (not $pty) { POSIX::close($ptyfd); POSIX::close($ttyfd); croak "Cannot create a new $class from fd $ptyfd: $!"; } $pty->autoflush(1); bless $pty => $class; my $slave = IO::Tty->new_from_fd( $ttyfd, "r+" ); if (not $slave) { POSIX::close($ttyfd); croak "Cannot create a new IO::Tty from fd $ttyfd: $!"; } $slave->autoflush(1); ${*$pty}{'io_pty_slave'} = $slave; ${*$pty}{'io_pty_ttyname'} = $ttyname; ${*$slave}{'io_tty_ttyname'} = $ttyname; return $pty; } sub ttyname { @_ == 1 or croak 'usage: $pty->ttyname();'; my $pty = shift; ${*$pty}{'io_pty_ttyname'}; } sub close_slave { @_ == 1 or croak 'usage: $pty->close_slave();'; my $master = shift; if ( exists ${*$master}{'io_pty_slave'} ) { close ${*$master}{'io_pty_slave'}; delete ${*$master}{'io_pty_slave'}; } } sub slave { @_ == 1 or croak 'usage: $pty->slave();'; my $master = shift; if ( exists ${*$master}{'io_pty_slave'} ) { return ${*$master}{'io_pty_slave'}; } my $tty = ${*$master}{'io_pty_ttyname'}; my $slave_fd = IO::Tty::_open_tty($tty); croak "Cannot open slave $tty: $!" if $slave_fd < 0; my $slave = IO::Tty->new_from_fd( $slave_fd, "r+" ); if (not $slave) { POSIX::close($slave_fd); croak "Cannot create IO::Tty from fd $slave_fd: $!"; } $slave->autoflush(1); ${*$slave}{'io_tty_ttyname'} = $tty; ${*$master}{'io_pty_slave'} = $slave; return $slave; } sub make_slave_controlling_terminal { @_ == 1 or croak 'usage: $pty->make_slave_controlling_terminal();'; my $self = shift; local (*DEVTTY); # lose controlling terminal explicitly if ( defined TIOCNOTTY ) { if ( open( \*DEVTTY, "/dev/tty" ) ) { ioctl( \*DEVTTY, TIOCNOTTY, 0 ); close \*DEVTTY; } } # Create a new 'session', lose controlling terminal. if ( POSIX::setsid() == -1 ) { warn "setsid() failed, strange behavior may result: $!\r\n"; } if ( open( \*DEVTTY, "/dev/tty" ) ) { warn "Could not disconnect from controlling terminal?!\n"; close \*DEVTTY; } # now open slave, this should set it as controlling tty on some systems # Use _open_tty() to ensure STREAMS modules (ptem, ldterm, ttcompat) # are pushed on Solaris/HP-UX, matching the slave() method. my $ttyname = ${*$self}{'io_pty_ttyname'}; my $slave_fd = IO::Tty::_open_tty($ttyname); croak "Cannot open slave $ttyname: $!" if $slave_fd < 0; my $slv = IO::Tty->new_from_fd( $slave_fd, "r+" ); croak "Cannot create IO::Tty from fd $slave_fd: $!" if not $slv; $slv->autoflush(1); if ( not exists ${*$self}{'io_pty_slave'} ) { ${*$self}{'io_pty_slave'} = $slv; } else { $slv->close; } # Acquire a controlling terminal if this doesn't happen automatically if ( not open( \*DEVTTY, "/dev/tty" ) ) { if ( defined TIOCSCTTY ) { if ( not defined ioctl( ${*$self}{'io_pty_slave'}, TIOCSCTTY, 0 ) ) { warn "warning: TIOCSCTTY failed, slave might not be set as controlling terminal: $!"; } } elsif ( defined TCSETCTTY ) { if ( not defined ioctl( ${*$self}{'io_pty_slave'}, TCSETCTTY, 0 ) ) { warn "warning: TCSETCTTY failed, slave might not be set as controlling terminal: $!"; } } else { warn "warning: You have neither TIOCSCTTY nor TCSETCTTY on your system\n"; return 0; } } if ( not open( \*DEVTTY, "/dev/tty" ) ) { warn "Error: could not connect pty as controlling terminal!\n"; return undef; } else { close \*DEVTTY; } return 1; } sub DESTROY { my $self = shift; # Only delete the internal reference; do not force-close the slave. # Perl's refcounting will close the fd when no references remain. # Force-closing here breaks consumers (e.g. IPC::Run) that hold # their own reference to the slave obtained via $pty->slave(). delete ${*$self}{'io_pty_slave'}; } *clone_winsize_from = \&IO::Tty::clone_winsize_from; *get_winsize = \&IO::Tty::get_winsize; *set_winsize = \&IO::Tty::set_winsize; *set_raw = \&IO::Tty::set_raw; 1; __END__ =head1 NAME IO::Pty - Pseudo TTY object class =head1 VERSION 1.28 =head1 SYNOPSIS use IO::Pty; $pty = IO::Pty->new; $slave = $pty->slave; foreach $val (1..10) { print $pty "$val\n"; $_ = <$slave>; print "$_"; } close($slave); =head1 DESCRIPTION C provides an interface to allow the creation of a pseudo tty. C inherits from L and so provide all the methods defined by the L package. Please note that pty creation is very system-dependent. If you have problems, see L for help. =head1 CONSTRUCTOR =over 3 =item new The C constructor takes no arguments and returns a new file object which is the master side of the pseudo tty. =back =head1 METHODS =over 4 =item ttyname() Returns the name of the slave pseudo tty. On UNIX machines this will be the pathname of the device. Use this name for informational purpose only, to get a slave filehandle, use slave(). =item slave() The C method will return the slave filehandle of the given master pty, opening it anew if necessary. If L is installed, you can then call C<$slave-Estty()> to modify the terminal settings. =item close_slave() The slave filehandle will be closed and destroyed. This is necessary in the parent after forking to get rid of the open filehandle, otherwise the parent will not notice if the child exits. Subsequent calls of C will return a newly opened slave filehandle. =item make_slave_controlling_terminal() This will set the slave filehandle as the controlling terminal of the current process, which will become a session leader, so this should only be called by a child process after a fork(), e.g. in the callback to C (see L). See the C script (also C) for an example how to correctly spawn a subprocess. =item set_raw() Will set the pty to raw. Note that this is a one-way operation, you need L to set the terminal settings to anything else. On some systems, the master pty is not a tty. This method checks for that and returns success anyway on such systems. Note that this method must be called on the slave, and probably should be called on the master, just to be sure, i.e. $pty->slave->set_raw(); $pty->set_raw(); =item clone_winsize_from(\*FH) Gets the terminal size from filehandle FH (which must be a terminal) and transfers it to the pty. Returns true on success and undef on failure. Note that this must be called upon the I, i.e. $pty->slave->clone_winsize_from(\*STDIN); On some systems, the master pty also isatty. I actually have no idea if setting terminal sizes there is passed through to the slave, so if this method is called for a master that is not a tty, it silently returns OK. See the C script for example code how to propagate SIGWINCH. =item get_winsize() Returns the terminal size, in a 4-element list. ($row, $col, $xpixel, $ypixel) = $tty->get_winsize() =item set_winsize($row, $col, $xpixel, $ypixel) Sets the terminal size. If not specified, C<$xpixel> and C<$ypixel> are set to 0. As with C, this must be called upon the I. =back =head1 SEE ALSO L, L, L, L, L Source code and issue tracker at L. =head1 AUTHORS Originally by Graham Barr EFE, based on the Ptty module by Nick Ing-Simmons EFE. Heavily rewritten by Roland Giersig EFE. Currently maintained by Todd Rinaldo. Contains copyrighted stuff from openssh v3.0p1, authored by Tatu Ylonen , Markus Friedl and Todd C. Miller . =head1 COPYRIGHT Now all code is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Nevertheless the above AUTHORS retain their copyrights to the various parts and want to receive credit if their source code is used. See the source for details. =head1 DISCLAIMER THIS SOFTWARE IS PROVIDED ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. In other words: Use at your own risk. Provided as is. Your mileage may vary. Read the source, Luke! And finally, just to be sure: Any Use of This Product, in Any Manner Whatsoever, Will Increase the Amount of Disorder in the Universe. Although No Liability Is Implied Herein, the Consumer Is Warned That This Process Will Ultimately Lead to the Heat Death of the Universe. =cut IO-Tty-1.28/META.yml000644 000765 000024 00000001341 15172373621 014267 0ustar00toddrstaff000000 000000 --- abstract: 'Pseudo ttys and constants' author: - 'Roland Giersig ' build_requires: ExtUtils::MakeMaker: '0' Test::More: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: IO-Tty no_index: directory: - t - inc requires: perl: '5.008008' resources: bugtracker: https://github.com/cpan-authors/IO-Tty/issues license: http://dev.perl.org/licenses/ repository: https://github.com/cpan-authors/IO-Tty.git version: '1.28' x_serialization_backend: 'CPAN::Meta::YAML version 0.020' IO-Tty-1.28/try000644 000765 000024 00000005525 15172372412 013564 0ustar00toddrstaff000000 000000 #!/usr/bin/perl use strict; use warnings; use blib; use IO::Pty; require POSIX; my $pty = IO::Pty->new; my $pid; unless (@ARGV) { { my $slave = $pty->slave; print %{*$pty},"\n"; print "master $pty $$pty ",$pty->ttyname,"\n"; print "slave $slave $$slave ",$slave->ttyname,"\n"; foreach my $val (1..10) { print $pty "$val\n"; $_ = <$slave>; print "$_"; } } close $pty; print "Done.\n"; exit 0; } else { pipe(my $stat_rdr, my $stat_wtr) or die "Cannot open pipe: $!"; $stat_wtr->autoflush(1); $pid = fork(); die "Cannot fork" if not defined $pid; unless ($pid) { close $stat_rdr; $pty->make_slave_controlling_terminal(); my $slave = $pty->slave(); close $pty; $slave->clone_winsize_from(\*STDIN); $slave->set_raw(); open(STDIN, '<&', $slave->fileno()) or die "Couldn't reopen STDIN for reading, $!\n"; open(STDOUT, '>&', $slave->fileno()) or die "Couldn't reopen STDOUT for writing, $!\n"; open(STDERR, '>&', $slave->fileno()) or die "Couldn't reopen STDERR for writing, $!\n"; close $slave; { exec(@ARGV) }; print $stat_wtr $!+0; die "Cannot exec(@ARGV): $!"; } close $stat_wtr; $pty->close_slave(); $pty->set_raw(); # now wait for child exec (eof due to close-on-exit) or exec error my $errstatus = sysread($stat_rdr, my $errno, 256); die "Cannot sync with child: $!" if not defined $errstatus; close $stat_rdr; if ($errstatus) { $! = $errno+0; die "Cannot exec(@ARGV): $!"; } $SIG{WINCH} = \&winch; parent($pty); } sub winch { $pty->slave->clone_winsize_from(\*STDIN); kill WINCH => $pid if $pid; print "STDIN terminal size changed.\n"; $SIG{WINCH} = \&winch; } my $log_fh; sub process { my ($rin,$src,$dst) = @_; my $buf = ''; my $read = sysread($src, $buf, 1); if (defined $read && $read) { syswrite($dst,$buf,$read); syswrite($log_fh,$buf,$read); } else { vec($rin, fileno($src), 1) = 0; } return $rin; } sub parent { open($log_fh, '>', 'log') || die "Cannot open log: $!"; my ($pty) = @_; my $tty = $pty; my ($rin,$win,$ein) = ('','',''); vec($rin, fileno(STDIN), 1) = 1; vec($rin, fileno($tty), 1) = 1; vec($win, fileno($tty), 1) = 1; vec($ein, fileno($tty), 1) = 1; select($tty); $| = 1; select(STDOUT); $| = 1; while (1) { my ($rout,$wout,$eout,$timeleft); (my $nfound,$timeleft) = select($rout=$rin,$wout=$win,$eout=$ein,3600); die "select failed:$!" if ($nfound < 0); if ($nfound > 0) { if (vec($eout, fileno($tty), 1)) { } if (vec($rout, fileno($tty), 1)) { $rin = process($rin,$tty,\*STDOUT); last unless (vec($rin, fileno($tty), 1)); } elsif (vec($rout, fileno(STDIN), 1) && vec($wout, fileno($tty), 1)) { $rin = process($rin,\*STDIN,$tty); } } } close($log_fh); } IO-Tty-1.28/Makefile.PL000644 000765 000024 00000040562 15172366073 015003 0ustar00toddrstaff000000 000000 use ExtUtils::MakeMaker; # Signal Testers that this is an unsupported platform. if ( $^O eq 'MSWin32' ) { print "This module requires a POSIX compliant system to work. Try cygwin if you need this module on windows\n"; die "OS unsupported"; } use strict; use warnings; use IO::File; use File::Spec; use Config qw(%Config); my %cfg; @cfg{qw(cc ccflags optimize ldflags)} = @Config{qw(cc ccflags optimize ldflags)}; for my $arg (@ARGV) { if ( $arg =~ /^(CC|CCFLAGS|OPTIMIZE|LDFLAGS)=(.*)/i ) { $cfg{lc($1)} = $2; } } if ($ENV{PERL_MM_OPT}) { # Split on whitespace just like EU::MM for ( split ' ', $ENV{PERL_MM_OPT} ) { if ( /^(CC|CCFLAGS|OPTIMIZE|LDFLAGS)=(.*)/i ) { $cfg{lc($1)} = $2; } } } my $flags = "$cfg{ccflags} $cfg{optimize} $cfg{ldflags}"; $flags =~ s/([^A-Za-z0-9 -_])/\\$1/g; # escape shell-metachars $|=1; # to see output immediately $^W=1; my %define; my @libs; my $Package_Version = MM->parse_version('Tty.pm'); my $Is_Beta = ($Package_Version =~ m/_/); open(SUB, ">xssubs.c") or die "open: $!"; print <<_EOT_; Now let's see what we can find out about your system (logfiles of failing tests are available in the conf/ dir)... _EOT_ # # Now some poking around in /dev to see what we can find # @define{qw(-DHAVE_CYGWIN -DHAVE_DEV_PTMX)} = (undef, undef) if ($^O =~ m/cygwin/i); $define{'-DHAVE_DEV_PTMX'} = undef if (-c '/dev/ptmx'); $define{'-DHAVE_DEV_PTYM_CLONE'} = undef if (-c '/dev/ptym/clone'); $define{'-DHAVE_DEV_PTC'} = undef if (-c "/dev/ptc"); $define{'-DHAVE_DEV_PTMX_BSD'} = undef if (-c "/dev/ptmx_bsd"); if (-d "/dev/ptym" and -d "/dev/pty") { $define{'-DHAVE_DEV_PTYM'} = undef; } # config tests go to a separate dir unless( mkdir 'conf', 0777 ) { my $e = $!; die "mkdir: $e" unless -d 'conf'; } use Cwd qw(getcwd); my $dir = getcwd; chdir('conf') or die "chdir: $!"; # Platform extension defines shared by function and header probes. # Without these, headers like pty.h or functions like openpty may not # be visible on strict POSIX systems or certain BSDs. my $platform_defines = <<'PLATDEFS'; /* Enable POSIX and platform extensions so functions like grantpt, ptsname, openpty etc. are declared in standard headers. */ #ifndef _GNU_SOURCE #define _GNU_SOURCE #endif #ifndef _XOPEN_SOURCE #define _XOPEN_SOURCE 600 #endif #ifndef _DEFAULT_SOURCE #define _DEFAULT_SOURCE #endif #ifdef __NetBSD__ #ifndef _NETBSD_SOURCE #define _NETBSD_SOURCE #endif #endif #ifdef __APPLE__ #ifndef _DARWIN_C_SOURCE #define _DARWIN_C_SOURCE #endif #endif #ifdef __sun #ifndef __EXTENSIONS__ #define __EXTENSIONS__ #endif #endif #ifdef __FreeBSD__ #ifndef __BSD_VISIBLE #define __BSD_VISIBLE 1 #endif #endif #ifdef __DragonFly__ #ifndef __BSD_VISIBLE #define __BSD_VISIBLE 1 #endif #endif #ifdef __OpenBSD__ #ifndef _BSD_SOURCE #define _BSD_SOURCE #endif #endif PLATDEFS open(TST,">compilerok.c") or die "open: $!"; print TST <<'ESQ'; int main () { return 0; } ESQ close(TST); if (system("$cfg{'cc'} $flags compilerok.c > compilerok.log 2>&1")) { die <<"__EOT__"; ERROR: cannot run the configured compiler '$cfg{'cc'}' (see conf/compilerok.log). Suggestions: 1) The compiler '$cfg{'cc'}' is not in your PATH. Add it to the PATH and try again. OR 2) The compiler isn't installed on your system. Install it. OR 3) You only have a different compiler installed (e.g. 'gcc'). Either fix the compiler config in the perl Config.pm or install a perl that was built with the right compiler (you could build perl yourself with the available compiler). Note: this is a system-administration issue, please ask your local admin for help. Thank you. __EOT__ } unlink qw(compilerok.c compilerok.log); # checking for various functions my %funcs = (ttyname => [""], openpty => ["", "-lutil"], _getpty => [""], strlcpy => [""], sigaction => [""], grantpt => [""], unlockpt => [""], getpt => [""], posix_openpt => [""], ptsname => [""], ptsname_r => [""], ); foreach my $f (sort keys %funcs) { open(TST,">functest_$f.c") or die "open: $!"; print TST <<"ESQ"; $platform_defines #include #include #include #include #include #include /* Try platform-specific headers for openpty and friends */ #if defined(__has_include) # if __has_include() # include # endif # if __has_include() # include # endif # if __has_include() # include # endif # if __has_include() # include # endif #endif int main () { /* The GNU C library defines this for functions which it implements to always fail with ENOSYS. Some functions are actually named something starting with __ and the normal name is an alias. */ #if defined (__stub_$f) || defined (__stub___$f) choke me #else /* Undef any macro wrapper (e.g. macOS _FORTIFY_SOURCE) so we get the real function symbol for the linker check below. */ #undef $f /* Cast through void* to avoid incompatible-function-pointer-types errors on newer clang (e.g. strlcpy returns size_t, not void). */ void *fptr = (void *) $f; (void)fptr; #endif ; return 0; } ESQ close(TST); print "Looking for $f()" . "." x (13-length($f)) . " "; # Try each library candidate in order (e.g. openpty is in libc on # glibc 2.34+/musl, but needs -lutil on BSDs and older glibc). my @lib_candidates = @{$funcs{$f}}; my $found = 0; for my $try_lib (@lib_candidates) { unless (system("$cfg{'cc'} $flags $try_lib functest_$f.c > functest_$f.log 2>&1")) { $define{"-DHAVE_\U$f"} = undef; push @libs, $try_lib if $try_lib; $found = 1; last; } } if ($found) { print "FOUND.\n"; unlink "functest_$f.c", "functest_$f.log"; } else { print "not found.\n"; } } # find various headerfiles my @headers = qw(termios.h termio.h libutil.h util.h pty.h sys/stropts.h sys/ptyio.h sys/pty.h); my %headers; foreach my $h (sort @headers) { my $def = $h; $def =~ s/\W/_/g; open(TST,">headtest_$def.c") or die "open: $!"; print TST <<"ESQ"; $platform_defines #include #include <$h> int main () { return 0; } ESQ close(TST); print "Looking for $h" . "." x (15-length($h)) . " "; if(system("$cfg{'cc'} $flags headtest_$def.c > headtest_$def.log 2>&1")) { print "not found.\n" } else { $headers{$h} = undef; $define{"-DHAVE_\U$def"} = $h; if ( $h eq 'util.h' ) { # Jump through hoops due to a header clash collision with perl # The following is highly unportable. # First, we need to figure out where the C compiler is looking # for includes. my $raw_cc_output = qx($cfg{'cc'} $flags -E -Wp,-v -xc /dev/null 2>&1); my @cc_output = split /\n+/, $raw_cc_output; my @inc_paths; foreach my $maybe_inc_path ( @cc_output ) { next unless $maybe_inc_path =~ /\A\s+/; my (undef, $inc_path) = split /\s+/, $maybe_inc_path, 3; push @inc_paths, $inc_path; } # With the list of include directories, try to find util.h foreach my $inc_path ( @inc_paths ) { my $abs_header_path = File::Spec->catfile($inc_path, 'util.h'); next unless -e $abs_header_path; # Bingo! Now we need to let the C compiler know, so that our XS # file will include it. # Again massively non-portable -- we ideally should be using something # smart to quote the value. $define{qq<-DUTIL_H_ABS_PATH=\\"$abs_header_path\\">} = $h if $abs_header_path; last; } } print "FOUND.\n"; unlink "headtest_$def.c", "headtest_$def.log"; } } # now write xssubs print SUB qq{sv_setpv(config, "@{[sort keys %define]}");\n}; my @ttsyms = qw(B0 B110 B115200 B1200 B134 B150 B153600 B1800 B19200 B200 B230400 B2400 B300 B307200 B38400 B460800 B4800 B50 B57600 B600 B75 B76800 B9600 BRKINT BS0 BS1 BSDLY CBAUD CBAUDEXT CBRK CCTS_OFLOW CDEL CDSUSP CEOF CEOL CEOL2 CEOT CERASE CESC CFLUSH CIBAUD CIBAUDEXT CINTR CKILL CLNEXT CLOCAL CNSWTCH CNUL CQUIT CR0 CR1 CR2 CR3 CRDLY CREAD CRPRNT CRTSCTS CRTSXOFF CRTS_IFLOW CS5 CS6 CS7 CS8 CSIZE CSTART CSTOP CSTOPB CSUSP CSWTCH CWERASE DEFECHO DIOC DIOCGETP DIOCSETP DOSMODE ECHO ECHOCTL ECHOE ECHOK ECHOKE ECHONL ECHOPRT EXTA EXTB FF0 FF1 FFDLY FIORDCHK FLUSHO HUPCL ICANON ICRNL IEXTEN IGNBRK IGNCR IGNPAR IMAXBEL INLCR INPCK ISIG ISTRIP IUCLC IXANY IXOFF IXON KBENABLED LDCHG LDCLOSE LDDMAP LDEMAP LDGETT LDGMAP LDIOC LDNMAP LDOPEN LDSETT LDSMAP LOBLK NCCS NL0 NL1 NLDLY NOFLSH OCRNL OFDEL OFILL OLCUC ONLCR ONLRET ONOCR OPOST PAGEOUT PARENB PAREXT PARMRK PARODD PENDIN RCV1EN RTS_TOG TAB0 TAB1 TAB2 TAB3 TABDLY TCDSET TCFLSH TCGETA TCGETS TCIFLUSH TCIOFF TCIOFLUSH TCION TCOFLUSH TCOOFF TCOON TCSADRAIN TCSAFLUSH TCSANOW TCSBRK TCSETA TCSETAF TCSETAW TCSETCTTY TCSETS TCSETSF TCSETSW TCXONC TERM_D40 TERM_D42 TERM_H45 TERM_NONE TERM_TEC TERM_TEX TERM_V10 TERM_V61 TIOCCBRK TIOCCDTR TIOCCONS TIOCEXCL TIOCFLUSH TIOCGETD TIOCGETC TIOCGETP TIOCGLTC TIOCSETC TIOCSETN TIOCSETP TIOCSLTC TIOCGPGRP TIOCGSID TIOCGSOFTCAR TIOCGWINSZ TIOCHPCL TIOCKBOF TIOCKBON TIOCLBIC TIOCLBIS TIOCLGET TIOCLSET TIOCMBIC TIOCMBIS TIOCMGET TIOCMSET TIOCM_CAR TIOCM_CD TIOCM_CTS TIOCM_DSR TIOCM_DTR TIOCM_LE TIOCM_RI TIOCM_RNG TIOCM_RTS TIOCM_SR TIOCM_ST TIOCNOTTY TIOCNXCL TIOCOUTQ TIOCREMOTE TIOCSBRK TIOCSCTTY TIOCSDTR TIOCSETD TIOCSIGNAL TIOCSPGRP TIOCSSID TIOCSSOFTCAR TIOCSTART TIOCSTI TIOCSTOP TIOCSWINSZ TM_ANL TM_CECHO TM_CINVIS TM_LCF TM_NONE TM_SET TM_SNL TOSTOP VCEOF VCEOL VDISCARD VDSUSP VEOF VEOL VEOL2 VERASE VINTR VKILL VLNEXT VMIN VQUIT VREPRINT VSTART VSTOP VSUSP VSWTCH VT0 VT1 VTDLY VTIME VWERASE WRAP XCASE XCLUDE XMT1EN XTABS); print <<_EOT_; Checking which symbols compile OK... (sorry for the tedious check, but some systems have not too clean header files, to say the least; '+' means OK, '-' means not defined and '*' has compile problems...) _EOT_ my %badsyms; my %ttsyms_exist; foreach my $s (sort @ttsyms) { $ttsyms_exist{$s} = undef; open(TST,">ttsymtest_$s.c") or die "open >ttsymtest_$s.c: $!"; print TST "#include \n"; foreach my $h (@headers) { print TST "#include <$h>\n" if exists $headers{$h}; } print TST <<"__EOT__"; #ifdef $s int main () { int x; x = (int)$s; return 0; } #else #line 29999 choke me badly on line 29999 #endif __EOT__ close(TST); if (system("$cfg{'cc'} $flags @{[keys %define]} ttsymtest_$s.c >ttsymtest_$s.log 2>&1")) { print SUB qq{newCONSTSUB(stash, "$s", newSV(0));\n}; # now check if the symbol is defined (should have an error message # for line 29999 in the logfile) open(CCOUT, "ttsymtest_$s.log") or die "open ttsymtest_$s.log: $!"; if (grep {m/29999/} ()) { # symbol not defined delete $ttsyms_exist{$s}; print "-$s "; unlink "ttsymtest_$s.c", "ttsymtest_$s.log"; } else { # was defined, but didn't compile $badsyms{$s} = undef; print "*$s "; } close CCOUT; } else { print "+$s "; print SUB qq{newCONSTSUB(stash, "$s", newSViv($s));\n}; unlink "ttsymtest_$s.c", "ttsymtest_$s.log"; } } close(SUB); print "\n\n"; # now back to Makefile dir chdir($dir) or die "chdir: $!"; my $all_ok = 1; foreach my $check ( { defines => [qw"-DHAVE_PTSNAME -DHAVE_PTSNAME_R"], msg => "WARNING! Neither ptsname() nor ptsname_r() could be found,\n so we cannot use a high-level interface like openpty().\n", }, { defines => [qw"-DHAVE_DEV_PTMX -DHAVE_DEV_PTYM_CLONE -DHAVE_DEV_PTC -DHAVE_DEV_PTMX_BSD -DHAVE__GETPTY -DHAVE_OPENPTY -DHAVE_GETPT -DHAVE_POSIX_OPENPT"], msg => "No high-level lib or clone device has been found, we will use BSD-style ptys.\n", }, ) { my $any = 0; foreach my $x (@{$check->{defines}}) { $any = 1 if exists $define{$x}; } if (not $any) { print $check->{msg}; $all_ok = 0; } } my %used_syms = map {($_, undef)} qw(TIOCSCTTY TCSETCTTY TIOCNOTTY TIOCGWINSZ TIOCSWINSZ); foreach my $s (sort keys %badsyms) { if (exists $used_syms{$s}) { print "WARNING! $s is used by Pty.pm but didn't compile. This may mean reduced functionality.\n"; $all_ok = 0; } else { print "Warning: $s has compile problems, it's thus not available (but it's not used by Pty.pm, so that's OK). See conf/ttsymtest_$s.log for details.\n"; } } print ">>> Configuration looks good! <<<\n\n" if $all_ok; print <<'_EOT_' if keys %badsyms; (If you need those missing symbols, check your header files where those are declared. I'm expecting them to be found in either termio.h or termios.h (and their #include hierarchy), but on some systems there are structs required that can be found in asm/*.h or linux/*.h. You can try to add these to @headers and see if that helps. Sorry, but the fault really lies with your system vendor.) _EOT_ print "Writing IO::Tty::Constant.pm...\n"; unless( mkdir 'Tty', 0777 ) { my $e = $!; die "mkdir: $e" unless -d 'Tty'; } open (POD, ">Tty/Constant.pm") or die "open: $!"; print POD <<"_EOT_"; package IO::Tty::Constant; our \$VERSION = '$Package_Version'; require Exporter; our \@ISA = qw(Exporter); our \@EXPORT_OK = qw(@ttsyms); __END__ =head1 NAME IO::Tty::Constant - Terminal Constants (autogenerated) =head1 SYNOPSIS use IO::Tty::Constant qw(TIOCNOTTY); ... =head1 DESCRIPTION This package defines constants usually found in or (and their #include hierarchy). Find below an autogenerated alphabetic list of all known constants and whether they are defined on your system (prefixed with '+') and have compilation problems ('o'). Undefined or problematic constants are set to 'undef'. =head1 DEFINED CONSTANTS =over 4 _EOT_ foreach my $s (@ttsyms) { if (exists $badsyms{$s}) { print POD "=item *\n\n"; } elsif (exists $ttsyms_exist{$s}) { print POD "=item +\n\n"; } else { print POD "=item -\n\n"; } print POD "$s\n\n"; } print POD <<_EOT_; =back =head1 FOR MORE INFO SEE L =cut _EOT_ close POD; print <<'__EOT__' if $Is_Beta; ********************************************************************** WARNING: this is a BETA version. If it works, good for you, if not, tell me, about it (including full output of 'perl Makefile.PL; make; make test;') and I'll see what I can do. ********************************************************************** __EOT__ print "DEFINE = @{[sort keys %define]}\n"; WriteMakefile1( 'NAME' => 'IO::Tty', 'VERSION_FROM' => 'Tty.pm', 'DEFINE' => join(" ", sort keys %define), 'LIBS' => join(" ", @libs), 'clean' => {'FILES' => 'xssubs.c conf Tty.exp_old log'}, 'realclean' => {'FILES' => 'Tty'}, 'AUTHOR' => 'Roland Giersig ', 'ABSTRACT' => 'Pseudo ttys and constants', 'LICENSE' => 'perl', 'MIN_PERL_VERSION' => '5.008008', 'CONFIGURE_REQUIRES' => { 'ExtUtils::MakeMaker' => 0, }, 'TEST_REQUIRES' => { 'Test::More' => 0, }, 'META_MERGE' => { 'meta-spec' => { version => 2 }, 'resources' => { license => ['http://dev.perl.org/licenses/'], repository => { type => 'git', url => 'https://github.com/cpan-authors/IO-Tty.git', web => 'https://github.com/cpan-authors/IO-Tty', }, bugtracker => { web => 'https://github.com/cpan-authors/IO-Tty/issues', }, }, }, ); sub WriteMakefile1 { my %params=@_; my $eumm_version=$ExtUtils::MakeMaker::VERSION; $eumm_version=eval $eumm_version; die "License not specified" if not exists $params{LICENSE}; if ($params{TEST_REQUIRES} and $eumm_version < 6.64) { $params{BUILD_REQUIRES}={ %{$params{BUILD_REQUIRES} || {}} , %{$params{TEST_REQUIRES}} }; delete $params{TEST_REQUIRES}; } if ($params{BUILD_REQUIRES} and $eumm_version < 6.5503) { $params{PREREQ_PM}={ %{$params{PREREQ_PM} || {}} , %{$params{BUILD_REQUIRES}} }; delete $params{BUILD_REQUIRES}; } delete $params{CONFIGURE_REQUIRES} if $eumm_version < 6.52; delete $params{MIN_PERL_VERSION} if $eumm_version < 6.48; delete $params{META_MERGE} if $eumm_version < 6.46; delete $params{META_ADD} if $eumm_version < 6.46; delete $params{LICENSE} if $eumm_version < 6.31; WriteMakefile(%params); } IO-Tty-1.28/META.json000644 000765 000024 00000002551 15172373622 014444 0ustar00toddrstaff000000 000000 { "abstract" : "Pseudo ttys and constants", "author" : [ "Roland Giersig " ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : 2 }, "name" : "IO-Tty", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "perl" : "5.008008" } }, "test" : { "requires" : { "Test::More" : "0" } } }, "release_status" : "stable", "resources" : { "bugtracker" : { "web" : "https://github.com/cpan-authors/IO-Tty/issues" }, "license" : [ "http://dev.perl.org/licenses/" ], "repository" : { "type" : "git", "url" : "https://github.com/cpan-authors/IO-Tty.git", "web" : "https://github.com/cpan-authors/IO-Tty" } }, "version" : "1.28", "x_serialization_backend" : "JSON::PP version 4.16" } IO-Tty-1.28/t/winsize.t000644 000765 000024 00000004066 15172366073 015150 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More; use IO::Pty; require POSIX; # pack_winsize / unpack_winsize are XS functions, always available # set_winsize / get_winsize require the slave to be a tty plan tests => 14; # Test pack_winsize / unpack_winsize round-trip { my $packed = IO::Tty::pack_winsize( 24, 80, 0, 0 ); ok( defined $packed, "pack_winsize returns a value" ); ok( length($packed) > 0, "pack_winsize returns non-empty data" ); my @dims = IO::Tty::unpack_winsize($packed); is( scalar @dims, 4, "unpack_winsize returns 4 values" ); is( $dims[0], 24, "row round-trips correctly" ); is( $dims[1], 80, "col round-trips correctly" ); is( $dims[2], 0, "xpixel round-trips correctly" ); is( $dims[3], 0, "ypixel round-trips correctly" ); } # Test with non-zero pixel values { my $packed = IO::Tty::pack_winsize( 50, 132, 800, 600 ); my @dims = IO::Tty::unpack_winsize($packed); is( $dims[0], 50, "row=50 round-trips" ); is( $dims[1], 132, "col=132 round-trips" ); } # Test unpack_winsize rejects wrong-sized input { eval { IO::Tty::unpack_winsize("too short") }; like( $@, qr/Bad arg length/, "unpack_winsize croaks on wrong-sized input" ); eval { IO::Tty::unpack_winsize("") }; like( $@, qr/Bad arg length/, "unpack_winsize croaks on empty input" ); } # Test pack_winsize with default pixel values (xpixel/ypixel default to 0) { my $packed_explicit = IO::Tty::pack_winsize( 24, 80, 0, 0 ); my $packed_default = IO::Tty::pack_winsize( 24, 80 ); is( $packed_explicit, $packed_default, "pack_winsize defaults xpixel/ypixel to 0" ); } # Test set_winsize / get_winsize on slave { my $pty = IO::Pty->new; my $slave = $pty->slave; SKIP: { skip "slave is not a tty on this system", 2 unless POSIX::isatty($slave); $slave->set_winsize( 40, 100, 0, 0 ); my @ws = $slave->get_winsize(); is( $ws[0], 40, "set_winsize/get_winsize row round-trip on slave" ); is( $ws[1], 100, "set_winsize/get_winsize col round-trip on slave" ); } } IO-Tty-1.28/t/PaxHeader/clone_winsize.t000644 000765 000024 00000000333 15160625445 020270 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/t/clone_winsize.t000644 000765 000024 00000004563 15160625445 016330 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More; use IO::Pty; require POSIX; plan tests => 7; # clone_winsize_from() copies terminal size from one tty to another. # It croaks if the source is not a tty, and silently returns 1 if # the destination is not a tty (e.g. master pty on some systems). # Basic clone between two slave ttys { my $pty1 = IO::Pty->new; my $pty2 = IO::Pty->new; my $slave1 = $pty1->slave; my $slave2 = $pty2->slave; SKIP: { skip "slave is not a tty on this system", 4 unless POSIX::isatty($slave1) && POSIX::isatty($slave2); # Set a known size on slave1 $slave1->set_winsize( 30, 90, 0, 0 ); my @ws1 = $slave1->get_winsize(); is( $ws1[0], 30, "source slave has row=30" ); is( $ws1[1], 90, "source slave has col=90" ); # Clone from slave1 to slave2 my $ret = $slave2->clone_winsize_from($slave1); ok( $ret, "clone_winsize_from returns true on success" ); my @ws2 = $slave2->get_winsize(); is( $ws2[0], 30, "cloned row matches source" ); } } # clone_winsize_from on master (not a tty on most systems) returns 1 { my $pty = IO::Pty->new; my $slave = $pty->slave; SKIP: { skip "slave is not a tty", 1 unless POSIX::isatty($slave); skip "master is a tty on this system (cannot test non-tty path)", 1 if POSIX::isatty($pty); my $ret = $pty->clone_winsize_from($slave); is( $ret, 1, "clone_winsize_from on non-tty master returns 1" ); } } # clone_winsize_from croaks when source is not a tty { my $pty = IO::Pty->new; my $slave = $pty->slave; # Use a regular file as a non-tty source open my $fh, '<', $0 or die "Cannot open $0: $!"; eval { $slave->clone_winsize_from($fh) }; like( $@, qr/not a tty/i, "clone_winsize_from croaks on non-tty source" ); close $fh; } # clone_winsize_from preserves pixel dimensions { my $pty1 = IO::Pty->new; my $pty2 = IO::Pty->new; my $slave1 = $pty1->slave; my $slave2 = $pty2->slave; SKIP: { skip "slave is not a tty on this system", 1 unless POSIX::isatty($slave1) && POSIX::isatty($slave2); $slave1->set_winsize( 25, 80, 640, 480 ); $slave2->clone_winsize_from($slave1); my @ws = $slave2->get_winsize(); is( $ws[0], 25, "cloned row with pixel values set" ); } } IO-Tty-1.28/t/PaxHeader/slave.t000644 000765 000024 00000000333 15160613163 016524 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/t/slave.t000644 000765 000024 00000002444 15160613163 014560 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 8; use IO::Pty; require POSIX; # Test slave() returns a valid tty { my $pty = IO::Pty->new; ok( defined $pty, "IO::Pty created" ); my $slave = $pty->slave; ok( defined $slave, "slave() returns a handle" ); ok( POSIX::isatty($slave), "slave is a tty" ); } # Test close_slave() and slave re-opening { my $pty = IO::Pty->new; my $slave1 = $pty->slave; my $fileno1 = fileno($slave1); ok( defined $fileno1, "first slave has a fileno" ); $pty->close_slave(); # After close_slave, calling slave() should re-open it my $slave2 = $pty->slave; ok( defined $slave2, "slave() works after close_slave()" ); ok( POSIX::isatty($slave2), "re-opened slave is a tty" ); } # Test that calling slave() twice returns the same object { my $pty = IO::Pty->new; my $slave1 = $pty->slave; my $slave2 = $pty->slave; is( fileno($slave1), fileno($slave2), "slave() returns same handle when not closed" ); } # Test that slave() after close_slave() gets a fresh handle { my $pty = IO::Pty->new; my $slave1 = $pty->slave; my $fn1 = fileno($slave1); $pty->close_slave(); my $slave2 = $pty->slave; ok( defined fileno($slave2), "re-opened slave has a valid fileno" ); } IO-Tty-1.28/t/PaxHeader/test.t000644 000765 000024 00000000333 15160616545 016400 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/t/test.t000644 000765 000024 00000016231 15160616545 014433 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 5; $^W = 1; # enable warnings use IO::Pty; use IO::Tty qw(TIOCSCTTY TIOCNOTTY TCSETCTTY); $IO::Tty::DEBUG = 1; require POSIX; my $Perl = $^X; diag("Configuration: $IO::Tty::CONFIG"); diag("Checking for appropriate ioctls:"); diag("TIOCNOTTY") if defined TIOCNOTTY; diag("TIOCSCTTY") if defined TIOCSCTTY; diag("TCSETCTTY") if defined TCSETCTTY; { my $pid = fork(); die "Cannot fork" if not defined $pid; unless ($pid) { # child closes stdin/out and reports test result via exit status sleep 0; close STDIN; close STDOUT; my $master = IO::Pty->new; my $slave = $master->slave(); my $master_fileno = $master->fileno; my $slave_fileno = $slave->fileno; $master->close(); if ( $master_fileno < 3 or $slave_fileno < 3 ) { # altered die("ERROR: masterfd=$master_fileno, slavefd=$slave_fileno"); # altered } exit(0); } is( wait, $pid, "fork exits with 0 exit code" ) or die("Wrong child"); is( $?, 0, "0 exit code from forked child - Checking that returned fd's don't clash with stdin/out/err" ); } { diag(" === Checking if child gets pty as controlling terminal"); my $master = IO::Pty->new; pipe( FROM_CHILD, TO_PARENT ) or die "Cannot create pipe: $!"; my $pid = fork(); die "Cannot fork" if not defined $pid; unless ($pid) { # child sleep(1); $master->make_slave_controlling_terminal(); my $slave = $master->slave(); close $master; close FROM_CHILD; print TO_PARENT "\n"; close TO_PARENT; open( TTY, "+>/dev/tty" ) or die "no controlling terminal"; autoflush TTY 1; print TTY "gimme on /dev/tty: "; my $s = ; chomp $s; print $slave "back on STDOUT: \U$s\n"; close TTY; close $slave; sleep(1); exit 0; } close TO_PARENT; $master->close_slave(); my $dummy; my $stat = sysread( FROM_CHILD, $dummy, 1 ); die "Cannot sync with child: $!" if not $stat; close FROM_CHILD; my ( $s, $chunk ); $SIG{ALRM} = sub { die("Timeout ($s)"); }; alarm(10); sysread( $master, $s, 100 ) or die "sysread() failed: $!"; like( $s, qr/gimme.*:/, "master object outputs: '$s'" ); print $master "seems OK!\n"; # collect all responses my $ret; while ( $ret = sysread( $master, $chunk, 100 ) ) { $s .= $chunk; } like( $s, qr/back on STDOUT: SEEMS OK!/, "STDOUT looks right" ); warn <<"_EOT_" unless defined $ret; WARNING: when the client closes the slave pty, the master gets an error (undef return value and \$! eq "$!") instead of EOF (0 return value). Please be sure to handle this in your application (Expect already does). _EOT_ alarm(0); kill TERM => $pid; } # now for the echoback tests diag( "Checking basic functionality and how your ptys handle large strings... This test may hang on certain systems, even though it is protected by alarm(). If the counter stops, try Ctrl-C, the test should continue." ); { my $randstring = q{fakjdf ijj845jtirg\r8e 4jy8 gfuoyhj\agt8h\0x00 gues98\0xFF 45th guoa\beh gt98hae 45t8u ha8rhg ue4ht 8eh tgo8he4 t8 gfj aoingf9a8hgf uain dgkjadshft+uehgf =usüand9ß87vgh afugh 8*h 98H 978H 7HG zG 86G (&g (O/g &(GF(/EG F78G F87SG F(/G F(/a sldjkf ha\@j<\rksdhf jk>~|ahsd fjkh asdHJKGDSG TRJKSGO JGDSFJDFHJGSDK1%&FJGSDGFSH\0xADJäDGFljkhf lakjs(dh fkjahs djfk hasjkdh fjklahs dfkjhdjkf haöjksdh fkjah sdjf)\$/§&k hasÄÜÖjkdh fkjhuerhtuwe htui eruth ZI AHD BIZA Di7GH )/g98 9 97 86tr(& TA&(t 6t &T 75r 5\$R%/4r76 5&/% R79 5 )/&}; my $master = IO::Pty->new; diag( "isatty(\$master): ", POSIX::isatty($master) ? "YES" : "NO" ); if ( POSIX::isatty($master) ) { $master->set_raw() or warn "warning: \$master->set_raw(): $!"; } pipe( FROM_CHILD, TO_PARENT ) or die "Cannot create pipe: $!"; my $pid = fork(); die "Cannot fork" if not defined $pid; unless ($pid) { # child sends back everything inverted my $c; my $slave = $master->slave(); close $master; diag( "isatty(\$slave): ", POSIX::isatty($slave) ? "YES" : "NO" ); $slave->set_raw() or warn "warning: \$slave->set_raw(): $!"; close FROM_CHILD; print TO_PARENT "\n"; close TO_PARENT; my $cnt = 0; my $linecnt = 0; while (1) { my $ret = sysread( $slave, $c, 1 ); warn "sysread(): $!" unless defined $ret; die "Slave got EOF at line $linecnt, byte $cnt.\n" unless $ret; $cnt++; if ( $c eq "\n" ) { $linecnt++; $cnt = 0; } else { $c = ~$c; } $ret = syswrite( $slave, $c, 1 ); warn "syswrite(): $!" unless defined $ret; } } close TO_PARENT; $master->close_slave(); my $dummy; my $stat = sysread( FROM_CHILD, $dummy, 1 ); die "Cannot sync with child: $!" if not $stat; close FROM_CHILD; diag("Child PID = $pid"); # parent sends down some strings and expects to get them back inverted my $maxlen = 0; foreach my $len ( 1 .. length($randstring) ) { my $s = substr( $randstring, 0, $len ); my $buf; my $ret = ""; my $inv = ~$s . "\n"; $s .= "\n"; my $sendbuf = $s; $SIG{ALRM} = $SIG{TERM} = $SIG{INT} = sub { die "TIMEOUT(SIG" . shift() . ")"; }; eval { alarm(15); while ( $sendbuf or length($ret) < length($s) ) { if ($sendbuf) { my $sent = syswrite( $master, $sendbuf, length($sendbuf) ); die "syswrite() failed: $!" unless defined $sent; $sendbuf = substr( $sendbuf, $sent ); } $buf = ""; my $read = sysread( $master, $buf, length($s) ); die "Couldn't read from child: $!" if not $read; $ret .= $buf; } alarm(0); }; if ($@) { warn $@; last; } if ( $ret eq $inv ) { $maxlen = $len; } else { if ( length($s) == length($ret) ) { warn "Got back a wrong string with the right length " . length($ret) . "\n"; } else { warn "Got back a wrong string with the wrong length " . length($ret) . " (instead of " . length($s) . ")\n"; } ok(0); last; } } $SIG{ALRM} = $SIG{TERM} = $SIG{INT} = 'DEFAULT'; if ( $maxlen < length($randstring) ) { warn <<"_EOT_"; WARNING: your raw ptys block when sending more than $maxlen bytes! This may cause problems under special scenarios, but you probably will never encounter that problem. _EOT_ } else { diag("Good, your raw ptys can handle at least $maxlen bytes at once."); } ok( $maxlen >= 200, "\$maxlen >= 200 ($maxlen)" ); close($master); sleep(1); kill TERM => $pid; } IO-Tty-1.28/t/pty_set_raw.t000644 000765 000024 00000003153 15172366073 016014 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More; use IO::Pty; use POSIX; plan tests => 14; my $master = IO::Pty->new; ok( $master, "IO::Pty->new succeeded" ); my $slave = $master->slave; ok( $slave, "got slave" ); ok( POSIX::isatty($slave), "slave is a tty" ); my $ret = $slave->set_raw(); ok( $ret, "set_raw() returned success" ); # verify termios flags match cfmakeraw expectations my $ttyno = fileno($slave); my $termios = POSIX::Termios->new; ok( $termios->getattr($ttyno), "getattr after set_raw" ); # lflag: all processing flags should be off my $lflag = $termios->getlflag(); is( $lflag & POSIX::ECHO(), 0, "ECHO is off after set_raw" ); is( $lflag & POSIX::ICANON(), 0, "ICANON is off after set_raw" ); # iflag: should be zeroed (no input processing) my $iflag = $termios->getiflag(); is( $iflag, 0, "iflag is 0 after set_raw" ); # oflag: should be zeroed (no output processing) my $oflag = $termios->getoflag(); is( $oflag, 0, "oflag is 0 after set_raw" ); # cflag: PARENB should be cleared, CS8 should be set my $cflag = $termios->getcflag(); is( $cflag & POSIX::PARENB(), 0, "PARENB is off after set_raw" ); is( $cflag & POSIX::CSIZE(), POSIX::CS8(), "CSIZE is CS8 after set_raw" ); # cc: VMIN=1, VTIME=0 for blocking single-byte reads is( $termios->getcc(POSIX::VMIN()), 1, "VMIN is 1 after set_raw" ); is( $termios->getcc(POSIX::VTIME()), 0, "VTIME is 0 after set_raw" ); # set_raw on master returns 1 silently when master is not a tty SKIP: { skip "master is a tty on this system", 1 if POSIX::isatty($master); my $mret = $master->set_raw(); is( $mret, 1, "set_raw on non-tty master returns 1" ); } IO-Tty-1.28/t/PaxHeader/ttyname.t000644 000765 000024 00000000333 15160613163 017073 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/t/ttyname.t000644 000765 000024 00000001366 15160613163 015131 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 5; use IO::Pty; # Test ttyname() on the master pty object { my $pty = IO::Pty->new; ok( defined $pty, "IO::Pty created" ); my $ttyname = $pty->ttyname; ok( defined $ttyname, "ttyname() returns a value" ); like( $ttyname, qr{/dev/}, "ttyname() looks like a device path" ); } # Test that slave ttyname matches what ttyname() returns { my $pty = IO::Pty->new; my $ttyname = $pty->ttyname; my $slave = $pty->slave; ok( defined $slave, "got slave" ); # The XS-level ttyname on the slave should match the stored name my $slave_ttyname = IO::Tty::ttyname($slave); is( $slave_ttyname, $ttyname, "XS ttyname() on slave matches Pty->ttyname()" ); } IO-Tty-1.28/t/PaxHeader/constants.t000644 000765 000024 00000000333 15160613163 017426 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/t/constants.t000644 000765 000024 00000001607 15160613163 015462 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 5; # Test that IO::Tty exports constants via import() { use IO::Tty qw(TIOCSCTTY TIOCNOTTY TCSETCTTY); # At least one of these should be defined on any POSIX system my $has_any = ( defined &TIOCSCTTY || defined &TIOCNOTTY || defined &TCSETCTTY ); ok( $has_any, "at least one terminal ioctl constant is available" ); } # Test that TIOCGWINSZ and TIOCSWINSZ are available (needed for winsize ops) { use IO::Tty::Constant; my $get = eval { IO::Tty::Constant::TIOCGWINSZ() }; ok( defined $get, "TIOCGWINSZ constant is available" ); my $set = eval { IO::Tty::Constant::TIOCSWINSZ() }; ok( defined $set, "TIOCSWINSZ constant is available" ); } # Test CONFIG variable { ok( defined $IO::Tty::CONFIG, "IO::Tty::CONFIG is defined" ); like( $IO::Tty::CONFIG, qr/-D/, "CONFIG contains compile flags" ); } IO-Tty-1.28/t/PaxHeader/pty_get_winsize.t000644 000765 000024 00000000333 15160052576 020642 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/t/pty_get_winsize.t000644 000765 000024 00000000700 15160052576 016667 0ustar00toddrstaff000000 000000 #!/usr/bin/env perl -w use strict; use warnings; use Test::More; if ( $^O =~ m!^(solaris|nto|aix)$! ) { plan skip_all => 'Problems on Solaris, QNX and AIX with this test'; } else { plan tests => 1; } use IO::Pty (); my @warnings; { local $^W = 1; local $SIG{'__WARN__'} = sub { push @warnings, @_ }; my $pty = IO::Pty->new(); () = $pty->get_winsize(); } is_deeply( \@warnings, [], 'get_winsize() doesn’t warn' ); IO-Tty-1.28/t/PaxHeader/pty_destroy.t000644 000765 000024 00000000333 15163274210 017776 xustar00toddrstaff000000 000000 122 LIBARCHIVE.xattr.com.apple.quarantine=MDA4MTs2OWU4YjUwYztzaGFyaW5nZDsyOUM0MTQ1Ri05Rjc3LTQyNUItOENDQy1EQzdBQUMzOEFENjE 97 SCHILY.xattr.com.apple.quarantine=0081;69e8b50c;sharingd;29C4145F-9F77-425B-8CCC-DC7AAC38AD61 IO-Tty-1.28/t/pty_destroy.t000644 000765 000024 00000003060 15163274210 016025 0ustar00toddrstaff000000 000000 #!perl use strict; use warnings; use Test::More tests => 5; use IO::Pty; require POSIX; # Reliable fd-open check: POSIX::dup succeeds only on open fds. sub fd_is_open { my ($fd) = @_; my $dup = POSIX::dup($fd); if ( defined $dup ) { POSIX::close($dup); return 1; } return 0; } # Test that destroying an IO::Pty object closes the slave fd # when no external references exist. # See https://github.com/toddr/IO-Tty/issues/14 { my $slave_fileno; { my $pty = IO::Pty->new; ok( defined $pty, "IO::Pty created" ); $slave_fileno = $pty->slave->fileno; } # $pty is now out of scope and destroyed. # The slave fd should have been closed (no external refs). ok( !fd_is_open($slave_fileno), "slave fd $slave_fileno closed after IO::Pty destruction (no external refs)" ); } # Test that destroying IO::Pty does NOT close the slave fd # when an external reference exists (e.g. IPC::Run scenario). # See https://github.com/toddr/IO-Tty/issues/62 { my $slave; my $slave_fileno; { my $pty = IO::Pty->new; ok( defined $pty, "IO::Pty created for external-ref test" ); $slave = $pty->slave; $slave_fileno = $slave->fileno; } # $pty destroyed, but $slave still holds a reference. # The slave fd must remain open. ok( fd_is_open($slave_fileno), "slave fd $slave_fileno stays open when external ref exists (GH #62)" ); close $slave; ok( !fd_is_open($slave_fileno), "slave fd $slave_fileno closed after explicit close" ); }