aboutsummaryrefslogtreecommitdiffhomepage
path: root/tests/interactive.expect.rc
blob: a1a855de0202c6b18a591f00f922f5c54262a6c2 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
# vim: set filetype=expect sw=4 ts=4 et:

log_user 0
log_file -noappend interactive.tmp.log

set fish ../fish

set timeout 2

set send_human {.05 .1 5 .02 .2}

proc abort {{msg "aborting"}} {
    error $msg
    exit 1
}

# # Debug logging

set loglevel debug ;# none, info, debug

proc log_info string {
    global loglevel
    switch $loglevel {
        info -
        debug {
            send_log "\[INFO] $string\n"
        }
    }
}

proc log_debug string {
    global loglevel
    switch $loglevel {
        debug {
            send_log "\[DEBUG] $string\n"
        }
    }
}

# Utilities

set prompt_counter 1
# expect_prompt takes an argument list like `expect` does.
# It supports a special pattern "unmatched" that is run if no
# other provided patterns match.
proc expect_prompt {args} {
    global prompt_counter
    upvar expect_out expect_out
    set prompt_pat [list -re "(?:\\r\\n?|^)prompt $prompt_counter>(?:$|\r)"]
    if {[llength $args] == 1 && [string match "\n*" $args]} {
        set args [join $args]
    }
    set prompt_action ""
    set expargs {}
    upvar expect_out up_expect_out
    set state "firstarg"
    foreach arg $args {
        switch $state {
            "pat" {
                lappend expargs $arg
                set state "action"
            }
            "action" {
                lappend expargs [subst -nocommands {
                    log_debug "matched extra pattern to expect_prompt: [quote \$expect_out(0,string)]"
                    if {\$matched} {
                        exp_continue
                    }
                    set matched yes
                    uplevel 1 {$arg}
                    exp_continue
                }]
                set state "firstarg"
            }
            "firstarg" -
            "arg" {
                if {$arg eq "unmatched" && $state eq "firstarg"} {
                    set state "unmatched"
                    continue
                }
                lappend expargs $arg
                switch $arg {
                    -gl -
                    -re -
                    -ex {
                        set state "pat"
                    }
                    -i -
                    -timeout {
                        set state "flagarg"
                    }
                }
            }
            "flagarg" {
                lappend expargs $arg
                set state "arg"
            }
            "unmatched" {
                if {$prompt_action ne ""} continue
                set prompt_action [subst -nocommands {
                    if {!\$matched} {
                        uplevel 1 {$arg}
                    }
                }]
            }
            default {
                error "BUG: non-exhaustive switch in expect_prompt"
            }
        }
    }
    if {[llength $expargs] > 0} {
        log_info "expecting prompt $prompt_counter + patterns"
    } else {
        log_info "expecting prompt $prompt_counter"
    }
    set expargs [concat $prompt_pat [list $prompt_action] $expargs]
    set matched no
    expect {*}$expargs
    incr prompt_counter
}

trace add execution expect {enter leave} trace_expect
proc trace_expect {cmd args} {
    if {[lindex $cmd 1] eq "*" && [llength $cmd] == 3} {
        # it's an `expect "*" {..}` command, don't log it
        return
    }
    switch [lindex $args end] {
        enter {
            log_debug "entering expect"
            uplevel {set expect_out(buffer) {}}
        }
        leave {
            set code [lindex $args 0]
            if {$code == 0} {
                log_debug "expect finished: [quote [uplevel set expect_out(buffer)]]"
            } else {
                log_debug "expect returned code $code"
            }
        }
    }
}

trace add execution exp_continue enter trace_exp_continue
proc trace_exp_continue {cmd op} {
    log_debug "exp_continue after consuming: [quote [uplevel set expect_out(buffer)]]"
}


trace add execution send enter trace_send
proc trace_send {cmd op} {
    log_info "[quote $cmd]"
}

trace add execution spawn {enter leave} trace_spawn
proc trace_spawn {cmd args} {
    switch [lindex $args end] {
        enter {
            log_info "[quote $cmd]"
        }
        leave {
            log_debug "[quote $cmd]: code [lindex $args 0], result [lindex $args 1]"
            expect_before {
                timeout {
                    expect "*" {
                        log_debug "timeout; buffer=[quote $expect_out(buffer)]"
                    }
                    abort "timeout"
                }
                eof {
                    log_debug "eof; buffer=[quote $expect_out(buffer)]"
                    abort "eof"
                }
            }
        }
    }
}

proc quote string {
    set map {
        \\      \\\\
        \r      \\r
        \n      \\n
        \t      \\t
        \a      \\a
        \v      \\v
        \x1b    \\e
        \x7f    \\x7f
    }
    for {set x 0} {$x<32} {incr x} {
        lappend map [format %c $x] [format \\x%02x $x]
    }
    string map $map $string
}

proc send_line args {
    if {[llength $args] > 0} {
        lset args end [lindex $args end]\r
    }
    send {*}$args
}

proc rand_int {low hi} {
    expr {entier(rand() * ($hi-$low))+$low}
}

# prints the output of `_echo_var $name` (defined in interactive.config)
proc print_var_contents name {
    # generate a random "guard" so we know where to stop matching
    # the randomness is to defend against the variable value containing the guard
    set guard [rand_int 1000000000 9999999999]

    # print the variable
    log_info "get_var_contents: $$name"
    send_line "_echo_var $name $guard"

    # match on the results
    set pat {\r\n@GUARD:$guard@\r\n(.*)\r\n@/GUARD:$guard@\r\n}
    set matched false
    expect_prompt -re [subst -nocommands -nobackslashes $pat] {
        log_info "get_var_contents: result: [quote $expect_out(1,string)]"
        puts $expect_out(1,string)
        exp_continue
    } unmatched {
        log_debug "unmatched: [quote $expect_out(buffer)]"
        abort "Didn't match output for variable $$name"
    }
}