1###############################################################################
2# ConMan Expect Language Library (CELL)
3###############################################################################
4# Written by Chris Dunlap <cdunlap@llnl.gov>.
5# Copyright (C) 2007-2018 Lawrence Livermore National Security, LLC.
6# Copyright (C) 2001-2007 The Regents of the University of California.
7# UCRL-CODE-2002-009.
8#
9# This file is part of ConMan: The Console Manager.
10# For details, see <https://dun.github.io/conman/>.
11#
12# ConMan is free software: you can redistribute it and/or modify it under
13# the terms of the GNU General Public License as published by the Free
14# Software Foundation, either version 3 of the License, or (at your option)
15# any later version.
16#
17# ConMan is distributed in the hope that it will be useful, but WITHOUT
18# ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
19# FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
20# for more details.
21#
22# You should have received a copy of the GNU General Public License along
23# with ConMan.  If not, see <http://www.gnu.org/licenses/>.
24###############################################################################
25
26
27proc conman_parse_opts {args_r} {
28#
29# Parses the 'args_r' var reference for ConMan command-line options.
30# Returns a list of options, while removing those options from the args_r list.
31#
32  upvar $args_r args
33  set cons {}
34  set opts {}
35
36  for {set i 0} {$i < [llength $args]} {incr i} {
37    set arg [lindex $args $i]
38    switch -regexp -- $arg {
39      "^--$"  {foreach x [lrange $args [expr $i+1] end] {lappend cons $x};
40               break}
41      "^-d$"  {lappend opts $arg; lappend opts [lindex $args [incr i]]}
42      "^-e$"  {incr i ;# ignore changing esc-char seq}
43      "^-"    {lappend opts $arg}
44      default {lappend cons $arg}
45    }
46  }
47  set args $cons
48  return $opts
49}
50
51
52proc conman_query {args {opts {}} {errmsg_r {}}} {
53#
54# Queries ConMan for consoles specified by the 'args' list;
55#   the 'opts' list specifies ConMan command-line options
56#   (eg, -r for matching console names via regex instead of globbing).
57# Returns a list of console names if successful; o/w, returns nothing.
58# On error, a message is written to the 'errmsg_r' var reference if present.
59#
60  upvar $errmsg_r errmsg
61  set errmsg "Undefined"
62  set consoles {}
63
64  set cmd [concat |conman -q $opts -- $args]
65  if {[catch {open $cmd r} file]} {
66    set errmsg $file
67    return
68  }
69  while {[gets $file console] >= 0} {
70    lappend consoles [string trim $console]
71  }
72  if {[catch {close $file} err]} {
73    regexp "^ERROR: *(\[^\r\n]*)" $err ignore msg
74    set errmsg [string trimright $msg "."]
75    return
76  }
77  return $consoles
78}
79
80
81proc conman_open {console {opts {}} {errmsg_r {}}} {
82#
83# Opens a ConMan session to the specified console;
84#   the 'opts' list specifies ConMan command-line options
85#   (eg, -j to join connections, -f to force open connections).
86# Returns the spawn_id if successful; o/w, returns nothing.
87# On error, a message is written to the 'errmsg_r' var reference if present.
88#
89  upvar $errmsg_r errmsg
90  set errmsg "Undefined"
91
92  if {[catch {eval spawn -noecho conman $opts -- $console} err]} {
93    set errmsg $err
94    return
95  }
96  expect -re "ERROR: *(\[^\r\n]*)" {
97    set errmsg [string trimright $expect_out(1,string) "."]
98    return
99  } -re "<ConMan> Connection \[^\r]+ opened.\r\n" {
100    ;# exp_break
101  } eof {
102    set errmsg "Exited"
103    return
104  } timeout {
105    set errmsg "Timed-out"
106    return
107  }
108  set errmsg {}
109  return $spawn_id
110}
111
112
113proc conman_close {spawn_id} {
114#
115# Closes the ConMan session associated with 'spawn_id'.
116#
117  exp_send -- "&."
118  expect -re "<ConMan> Connection \[^\r]+ closed.\r\n"
119  close
120  wait
121  return
122}
123
124
125proc conman_run {nproc consoles cmd args} {
126#
127# Runs the 'cmd' procedure on each console identified by the 'consoles' list.
128# The consoles list will be parsed for ConMan command-line options,
129#   and ConMan will be queried for matching console names.
130# The 'nproc' variable specifies the number of concurrent ConMan sessions
131#   on which the 'cmd' procedure is run; if nproc=1, execution is serial.
132# The first three args of the 'cmd' procedure refer to:
133#   1) the spawn_id of that particular ConMan console session,
134#   2) the spawn_id for any data being returned to the user via stdout
135#      (line buffered and prepended with the console name), and
136#   3) the name of the console associated with that particular session.
137#   These first three args are automagically set by conman_run.
138# Additional args specified by the variable-length 'args' list
139#   will be passed on to any remaining args in the 'cmd' procedure arg list.
140# Data being returned from multiple concurrent consoles can be demux'd with
141#   a stable sort such as: "sort -s -t: -k1,1".
142#
143  global conman_global_ids              ;# global req'd for indirect spawn ids
144  set conman_global_ids {}
145
146  if {$nproc <= 0} {
147    return
148  }
149  set opts [conman_parse_opts consoles]
150  set consoles [conman_query $consoles $opts err]
151  if {[llength $consoles] == 0} {
152    send_error -- "ERROR: $err.\n"
153    return
154  }
155  while {[llength $consoles] && $nproc > 0} {
156    if {[conman_run_next conman_global_ids id2con consoles opts cmd args]} {
157      incr nproc -1
158    }
159  }
160  set timeout -1
161  expect -i conman_global_ids -re "(^\[^\r]*)\r\n" {
162    send_user -- "$id2con($expect_out(spawn_id)):$expect_out(1,string)\n"
163    exp_continue
164  } eof {
165    catch {wait -i -1}
166    if {[string length $expect_out(buffer)] > 0} {
167      send_user -- "$id2con($expect_out(spawn_id)):$expect_out(buffer)\n"
168    }
169    set index [lsearch $conman_global_ids $expect_out(spawn_id)]
170    set conman_global_ids [lreplace $conman_global_ids $index $index]
171    while {[llength $consoles]} {
172      if {[conman_run_next conman_global_ids id2con consoles opts cmd args]} {
173        break
174      }
175    }
176    if {[llength $conman_global_ids]} {
177      exp_continue
178    }
179  }
180  return
181}
182
183
184proc conman_run_next {ids_r id2con_r consoles_r opts_r cmd_r args_r} {
185#
186# This is an internal routine that is only to be called by "conman_run"!
187# Returns 1 if successful; o/w, returns 0.
188#
189  upvar $ids_r conman_global_ids
190  upvar $id2con_r id2con
191  upvar $consoles_r consoles
192  upvar $opts_r opts
193  upvar $cmd_r cmd
194  upvar $args_r args
195
196  if {[llength $consoles] == 0} {
197    return 0
198  }
199  set console [lindex $consoles 0]      ;# car
200  set consoles [lrange $consoles 1 end] ;# cdr
201
202  if {[catch {spawn -noecho -pty} err]} {
203    send_error -- "ERROR: $err.\n"
204    return 0
205  }
206  if {[fork] == 0} {
207    set stdout_id $spawn_id
208    set console_id [conman_open $console $opts err]
209    if {[string length $console_id] == 0} {
210      send_error -- "$console:ERROR: $err.\n"
211      exit 0
212    }
213    eval $cmd $console_id $stdout_id $console $args
214    conman_close $console_id
215    close -i $stdout_id
216    wait -i $stdout_id
217    exit 0
218  }
219  close -slave
220  lappend conman_global_ids $spawn_id
221  set id2con($spawn_id) $console
222  return 1
223}
224
225
226proc conman_check_console_state {spawn_id {tmout 4}} {
227#
228# Checks the output of the ConMan session associated with 'spawn_id'
229#   in an attempt to determine the state of the console.
230# Possible states are:
231#   active, error, inactive, login, rmc, shell, srm, srom
232#
233  set timeout 1
234  expect -re "\r\n<ConMan> \[^\r]*\r\n" {
235    exp_continue
236  } -re ".+" {
237    return "active"
238  } eof {
239    return "error"
240  }
241
242  set expect_out(buffer) ""
243  exp_send "\r"
244
245  set timeout $tmout
246  expect -nocase -re "(login|password):.*\$" {
247    return "login"
248  } -gl ">>>\$" {
249    return "srm"
250  } -gl "^SROM> \$" {
251    return "srom"
252  } -gl "^RMC>\$" {
253    return "rmc"
254  } -re "^\[^\r]*(%|#|\\\$|]|\[^>]>) \$" {
255    return "shell"
256  } -gl "\n" {
257    exp_continue -continue_timer
258  } eof {
259    return "error"
260  }
261
262  if {[string length $expect_out(buffer)] == 0} {
263    return "inactive"
264  }
265  return "active"
266}
267