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";
168 sub read_password
($;$$) {
169 my ($query, $infd, $outfd) = @_;
175 if (!-t
$infd) { # Not a terminal? Then just get a line...
178 die "EOF while reading password\n" if !defined $password;
179 chomp $password; # Chop off the newline
187 $old_termios = tcgetattr
($infd);
188 my $raw_termios = {%$old_termios};
189 cfmakeraw
($raw_termios);
190 tcsetattr
($infd, $raw_termios);
194 syswrite($outfd, $query, length($query));
195 while (($got = sysread($infd, $ch, 1))) {
196 my ($ord) = unpack('C', $ch);
197 last if $ord == 4; # ^D / EOF
198 if ($ord == 0xA || $ord == 0xD) {
199 # newline, we're done
200 syswrite($outfd, "\r\n", 2);
202 } elsif ($ord == 3) { # ^C
203 die "password input aborted\n";
204 } elsif ($ord == 0x7f) {
205 # backspace - if it's the first key disable
208 if (length($password)) {
210 syswrite($outfd, "\b \b", 3);
212 } elsif ($ord == 0x09) {
213 # TAB disables the asterisk-echo
216 # other character, append to password, if it's
217 # the first character enable asterisks echo
220 syswrite($outfd, '*', 1) if $echo;
223 die "read error: $!\n" if !defined($got);
226 tcsetattr
($infd, $old_termios);
231 sub get_confirmed_password
{
232 my $pw1 = read_password
('Enter new password: ');
233 my $pw2 = read_password
('Retype new password: ');
234 die "passwords do not match\n" if $pw1 ne $pw2;
243 my ($master, $ttyname) = createpty
();
250 return bless $self, $class;
255 sub master
{ return $_[0]->{master
} }
256 sub ttyname
{ return $_[0]->{ttyname
} }
262 close($self->{master
});
267 return $openslave->($self->{ttyname
});
271 my ($self, $columns, $rows) = @_;
272 tcsetsize
($self->{master
}, $columns, $rows);
275 # get_size -> (columns, rows)
278 return tcgetsize
($self->{master
});
282 my ($self, $signal) = @_;
283 if (!ioctl($self->{master
}, TIOCSIG
, $signal)) {
284 # kill fallback if the ioctl does not work
285 kill $signal, $self->get_foreground_pid()
286 or die "failed to send signal: $!\n";
290 sub get_foreground_pid
{
292 my $pid = pack('L', 0);
293 ioctl($self->{master
}, TIOCGPGRP
, $pid)
294 or die "failed to get foreground pid: $!\n";
295 return unpack('L', $pid);
300 return 0 != $self->get_foreground_pid();
303 sub make_controlling_terminal
{
306 #lose_controlling_terminal();
308 my $slave = $self->open_slave();
309 ioctl($slave, TIOCSCTTY
, 0)
310 or die "failed to change controlling tty: $!\n";
311 POSIX
::dup2
(fileno($slave), 0) or die "failed to dup stdin\n";
312 POSIX
::dup2
(fileno($slave), 1) or die "failed to dup stdout\n";
313 POSIX
::dup2
(fileno($slave), 2) or die "failed to dup stderr\n";
314 CORE
::close($slave) if fileno($slave) > 2;
315 CORE
::close($self->{master
});
320 return tcgetattr
($self->{master
});
324 my ($self, $termios) = @_;
325 return tcsetattr
($self->{master
}, $termios);
329 my ($self, $ccidx) = @_;
330 my $attrs = $self->getattr();
331 my $data = pack('C', $attrs->{cc
}->[$ccidx]);
332 syswrite($self->{master
}, $data)
333 == 1 || die "write failed: $!\n";
338 $self->send_cc(VEOF
);
343 $self->send_cc(VINTR
);