7 use POSIX qw(O_RDWR O_NOCTTY);
12 TCGETS => 0x5401, # fixed, from asm-generic/ioctls.h
13 TCSETS => 0x5402, # fixed, from asm-generic/ioctls.h
14 TIOCGWINSZ => 0x5413, # fixed, from asm-generic/ioctls.h
15 TIOCSWINSZ => 0x5414, # fixed, from asm-generic/ioctls.h
16 TIOCSCTTY => 0x540E, # fixed, from asm-generic/ioctls.h
17 TIOCNOTTY => 0x5422, # fixed, from asm-generic/ioctls.h
18 TIOCGPGRP => 0x540F, # fixed, from asm-generic/ioctls.h
19 TIOCSPGRP => 0x5410, # fixed, from asm-generic/ioctls.h
21 # IOC: dir:2 size:14 type:8 nr:8
22 # Get pty number: dir=2 size=4 type='T' nr=0x30
23 TIOCGPTN => 0x80045430,
25 # Set pty lock: dir=1 size=4 type='T' nr=0x31
26 TIOCSPTLCK => 0x40045431,
28 # Send signal: dir=1 size=4 type='T' nr=0x36
29 TIOCSIG => 0x40045436,
54 # Open the master file descriptor:
55 sysopen(my $master, '/dev/ptmx', O_RDWR | O_NOCTTY)
56 or die "failed to create pty: $!\n";
59 my $ttynum = pack('L', 0);
60 ioctl($master, TIOCGPTN, $ttynum)
61 or die "failed to query pty number: $!\n";
62 $ttynum = unpack('L', $ttynum);
64 # Get the slave name/path
65 my $ttyname = "/dev/pts/$ttynum";
68 my $false = pack('L', 0);
69 ioctl($master, TIOCSPTLCK, $false)
70 or die "failed to unlock pty: $!\n";
72 return ($master, $ttyname);
78 # Create a slave file descriptor:
79 sysopen(my $slave, $ttyname, O_RDWR | O_NOCTTY)
80 or die "failed to open slave pty handle: $!\n";
84 sub lose_controlling_terminal() {
85 # Can we open our current terminal?
86 if (sysopen(my $ttyfd, '/dev/tty', O_RDWR)) {
88 ioctl($ttyfd, TIOCNOTTY, 0)
89 or die "failed to disconnect controlling tty: $!\n";
96 my $cc = $termios{cc} // [];
98 push @$cc, (0) x (19-@$cc);
103 return pack('LLLLCC[19]',
104 $termios{iflag} || 0,
105 $termios{oflag} || 0,
106 $termios{cflag} || 0,
107 $termios{lflag} || 0,
112 my $parse_termios = sub {
114 my ($iflag, $oflag, $cflag, $lflag, $line, @cc) =
115 unpack('LLLLCC[19]', $blob);
129 ~(POSIX::IGNBRK | POSIX::BRKINT | POSIX::PARMRK | POSIX::ISTRIP |
130 POSIX::INLCR | POSIX::IGNCR | POSIX::ICRNL | POSIX::IXON);
131 $termios->{oflag} &= ~POSIX::OPOST;
133 ~(POSIX::ECHO | POSIX::ECHONL | POSIX::ICANON | POSIX::ISIG |
135 $termios->{cflag} &= ~(POSIX::CSIZE | POSIX::PARENB);
136 $termios->{cflag} |= POSIX::CS8;
141 my $blob = termios();
142 ioctl($fd, TCGETS, $blob) or die "failed to get terminal attributes\n";
143 return $parse_termios->($blob);
147 my ($fd, $termios) = @_;
148 my $blob = termios(%$termios);
149 ioctl($fd, TCSETS, $blob) or die "failed to set terminal attributes\n";
152 # tcgetsize -> (columns, rows)
155 my $struct_winsz = pack('SSSS', 0, 0, 0, 0);
156 ioctl($fd, TIOCGWINSZ, $struct_winsz)
157 or die "failed to get window size: $!\n";
158 return reverse unpack('SS', $struct_winsz);
162 my ($fd, $columns, $rows) = @_;
163 my $struct_winsz = pack('SSSS', $rows, $columns, 0, 0);
164 ioctl($fd, TIOCSWINSZ, $struct_winsz)
165 or die "failed to set window size: $!\n";
173 my ($master, $ttyname) = createpty();
180 return bless $self, $class;
185 sub master { return $_[0]->{master} }
186 sub ttyname { return $_[0]->{ttyname} }
192 close($self->{master});
197 return $openslave->($self->{ttyname});
201 my ($self, $columns, $rows) = @_;
202 tcsetsize($self->{master}, $columns, $rows);
205 # get_size -> (columns, rows)
208 return tcgetsize($self->{master});
212 my ($self, $signal) = @_;
213 if (!ioctl($self->{master}, TIOCSIG, $signal)) {
214 # kill fallback if the ioctl does not work
215 kill $signal, $self->get_foreground_pid()
216 or die "failed to send signal: $!\n";
220 sub get_foreground_pid {
222 my $pid = pack('L', 0);
223 ioctl($self->{master}, TIOCGPGRP, $pid)
224 or die "failed to get foreground pid: $!\n";
225 return unpack('L', $pid);
230 return 0 != $self->get_foreground_pid();
233 sub make_controlling_terminal {
236 #lose_controlling_terminal();
238 my $slave = $self->open_slave();
239 ioctl($slave, TIOCSCTTY, 0)
240 or die "failed to change controlling tty: $!\n";
241 POSIX::dup2(fileno($slave), 0) or die "failed to dup stdin\n";
242 POSIX::dup2(fileno($slave), 1) or die "failed to dup stdout\n";
243 POSIX::dup2(fileno($slave), 2) or die "failed to dup stderr\n";
244 CORE::close($slave) if fileno($slave) > 2;
245 CORE::close($self->{master});
250 return tcgetattr($self->{master});
254 my ($self, $termios) = @_;
255 return tcsetattr($self->{master}, $termios);
259 my ($self, $ccidx) = @_;
260 my $attrs = $self->getattr();
261 my $data = pack('C', $attrs->{cc}->[$ccidx]);
262 syswrite($self->{master}, $data)
263 == 1 || die "write failed: $!\n";
268 $self->send_cc(VEOF);
273 $self->send_cc(VINTR);