Check-in [a47c5e2ddc]
Not logged in

Many hyperlinks are disabled.
Use anonymous login to enable hyperlinks.

Overview
Comment:improve topcua example from [9dc5a09111]
Timelines: family | ancestors | descendants | both | trunk
Files: files | file ages | folders
SHA1: a47c5e2ddc4ab806662684ce19f234fea55d68d6
User & Date: chw 2019-05-28 19:53:39
Context
2019-05-29
03:43
add selected tcl upstream changes check-in: a3017c1eb8 user: chw tags: trunk
2019-05-28
19:53
improve topcua example from [9dc5a09111] check-in: a47c5e2ddc user: chw tags: trunk
2019-05-26
21:25
add tk upstream changes plus some cleanup check-in: c97c43034e user: chw tags: trunk
Changes

Changes to jni/topcua/examples/fuse.tcl.

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
..
77
78
79
80
81
82
83

84

85


86
87
88
89

90
91
92
93
94
95
96
97
98
...
103
104
105
106
107
108
109
110
111
112
113

114
115
116
117
118
119
120
...
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
...
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
229
230
231
232
233
234
235
236
}

# OPCUA connect and retrieve tree into variable ::T,
# key is browse path, value a list of node ID and
# class path, thus variables can be identified
# with the pattern "*/Variable" on the class path.
# Variable ::R is for reverse mapping node ID to
# browse path.



log "starting up"
opcua new client C
log "connecting to $url"
opcua connect C $url
log "connected"

# Fetch custom types, if any
catch {opcua gentypes C}
log "fetched types, if any"

apply {tree {
    foreach {brpath nodeid clspath refid typeid} $tree {










	set ::T($brpath) [list $nodeid $clspath]
	set ::R($nodeid) $brpath
    }
}} [opcua ptree C]
log "fetched tree"

# Fuse entry points; the "fs_getattr" function fills
................................................................................
    log "getattr $path"
    if {$path eq "/"} {
        return [dict create type directory mode 0755 nlinks 2]
    }
    if {[info exists ::T($path)]} {
	lassign $::T($path) nodeid clspath
	if {[string match "*/Variable" $clspath]} {

	    # Fetch Value attribute into cache

	    if {![info exists ::D($nodeid)]} {


		if {[catch {set ::D($nodeid) [opcua read C $nodeid]}]} {
		    return -code error -errorcode [list POSIX EIO {}]
		}
		set ::M($nodeid) [clock seconds]

	    }
	    return [dict create mode 0444 nlinks 1 \
			mtime $::M($nodeid) \
			size [string length $::D($nodeid)]]
	}
	return [dict create type directory mode 0755 nlinks 2]
    }
    return -code error -errorcode [list POSIX ENOENT {}]
}
................................................................................
	lassign $::T($path) nodeid clspath
	if {[string match "*/Variable" $clspath]} {
	    # Cached Value attribute must exist
	    if {"RDONLY" ni [dict get $fileinfo flags] ||
		![info exists ::D($nodeid)]} {
		return -code error -errorcode [list POSIX EACCES {}]
	    }
	    # Success: empty return
	    incr ::U($nodeid)
	    return
	}

    }
    return -code error -errorcode [list POSIX ENOENT {}]
}

proc fs_readdir {context path fileinfo} {
    log "readdir $path"
    if {[info exists ::T($path)]} {
................................................................................
	    # Success, but nothing read
	    return
	}
    }
    return -code error -errorcode [list POSIX ENOENT {}]
}

proc fs_flush {context path fileinfo} {
    log "flush $path"
    if {[info exists ::T($path)]} {
	lassign $::T($path) nodeid clspath
	# Cleanup cached Value attribute, if any
	if {[incr ::U($nodeid) -1] <= 0} {
	    unset -nocomplain ::D($nodeid)
	    unset -nocomplain ::M($nodeid)
	    unset -nocomplain ::U($nodeid)
	}
    }
    return
}

proc fs_destroy {context} {
    log "shutdown, disconnecting"
    catch {opcua disconnect C}
................................................................................
# Create and serve fuse file system

fuse create FS \
    -getattr fs_getattr \
    -readdir fs_readdir \
    -open fs_open \
    -read fs_read \
    -flush fs_flush \
    -destroy fs_destroy

FS $mountpoint -s -ononempty -ofsname=OPCUA
log "created/mounted file system"

# Remove old cache entries after 60 seconds
# and do some keep-alive/reconnect handling.

proc fs_cleanup {url} {

    set status /Root/Objects/Server/ServerStatus
    if {[info exists ::T($status)]} {
	if {[catch {opcua read C [lindex $::T($status) 0]} error]} {
	    log "reading server status: $error"
	    catch {opcua disconnect C}
	    log "reconnecting to $url"
	    if {[catch {opcua connect C $url} error]} {
		log "connect failed: $error"
	    }
	}
    }
    set now [clock seconds]
    foreach nodeid [array names ::D] {
	if {[info exists ::U($nodeid)]} {
	    continue
	}
	if {$now - $::M($nodeid) > 60} {
	    log "expire $::R($nodeid)"
	    unset -nocomplain ::D($nodeid)
	    unset -nocomplain ::M($nodeid)
	    unset -nocomplain ::U($nodeid)
	}
    }
    after 15000 [list fs_cleanup $url]
}

fs_cleanup $url

# Start event loop

log "enter event loop"
vwait forever







|
>
>













>
>
>
>
>
>
>
>
>
>







 







>
|
>
|
>
>



|
>

|







 







|



>







 







|
|


|
|
<
<
<
<







 







|









>













<
<
<
|






|








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
..
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
...
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
...
178
179
180
181
182
183
184
185
186
187
188
189
190




191
192
193
194
195
196
197
...
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
229
230
231
232



233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
}

# OPCUA connect and retrieve tree into variable ::T,
# key is browse path, value a list of node ID and
# class path, thus variables can be identified
# with the pattern "*/Variable" on the class path.
# Variable ::R is for reverse mapping node ID to
# browse path. Namespace prefixes are stripped
# from browse paths, as long as they are unique
# among the entire address space.

log "starting up"
opcua new client C
log "connecting to $url"
opcua connect C $url
log "connected"

# Fetch custom types, if any
catch {opcua gentypes C}
log "fetched types, if any"

apply {tree {
    foreach {brpath nodeid clspath refid typeid} $tree {
	set short $brpath
	regsub -all -- {/[1-9][0-9]*:} $short {/} short
	incr t($short)
    }
    foreach {brpath nodeid clspath refid typeid} $tree {
	set short $brpath
	regsub -all -- {/[1-9][0-9]*:} $short {/} short
	if {$t($short) == 1} {
	    set brpath $short
	}
	set ::T($brpath) [list $nodeid $clspath]
	set ::R($nodeid) $brpath
    }
}} [opcua ptree C]
log "fetched tree"

# Fuse entry points; the "fs_getattr" function fills
................................................................................
    log "getattr $path"
    if {$path eq "/"} {
        return [dict create type directory mode 0755 nlinks 2]
    }
    if {[info exists ::T($path)]} {
	lassign $::T($path) nodeid clspath
	if {[string match "*/Variable" $clspath]} {
	    set now [clock seconds]
	    # Fetch Value attribute into cache, if cache entry doesn't
	    # exist at all, or is not open and older than 10 seconds.
	    if {![info exists ::D($nodeid)] ||
		($::U($nodeid) <= 0 && $now - $::M($nodeid) >= 10)} {
		log "refresh $path"
		if {[catch {set ::D($nodeid) [opcua read C $nodeid]}]} {
		    return -code error -errorcode [list POSIX EIO {}]
		}
		set ::M($nodeid) $now
		set ::U($nodeid) 0
	    }
	    return [dict create mode 0666 nlinks 1 \
			mtime $::M($nodeid) \
			size [string length $::D($nodeid)]]
	}
	return [dict create type directory mode 0755 nlinks 2]
    }
    return -code error -errorcode [list POSIX ENOENT {}]
}
................................................................................
	lassign $::T($path) nodeid clspath
	if {[string match "*/Variable" $clspath]} {
	    # Cached Value attribute must exist
	    if {"RDONLY" ni [dict get $fileinfo flags] ||
		![info exists ::D($nodeid)]} {
		return -code error -errorcode [list POSIX EACCES {}]
	    }
	    # Success, increment use counter and return empty result.
	    incr ::U($nodeid)
	    return
	}
	return -code error -errorcode [list POSIX EACCES {}]
    }
    return -code error -errorcode [list POSIX ENOENT {}]
}

proc fs_readdir {context path fileinfo} {
    log "readdir $path"
    if {[info exists ::T($path)]} {
................................................................................
	    # Success, but nothing read
	    return
	}
    }
    return -code error -errorcode [list POSIX ENOENT {}]
}

proc fs_release {context path fileinfo} {
    log "release $path"
    if {[info exists ::T($path)]} {
	lassign $::T($path) nodeid clspath
	# Decrement use counter for cache entry.
	incr ::U($nodeid) -1




    }
    return
}

proc fs_destroy {context} {
    log "shutdown, disconnecting"
    catch {opcua disconnect C}
................................................................................
# Create and serve fuse file system

fuse create FS \
    -getattr fs_getattr \
    -readdir fs_readdir \
    -open fs_open \
    -read fs_read \
    -release fs_release \
    -destroy fs_destroy

FS $mountpoint -s -ononempty -ofsname=OPCUA
log "created/mounted file system"

# Remove old cache entries after 60 seconds
# and do some keep-alive/reconnect handling.

proc fs_cleanup {url} {
    log "cleanup ..."
    set status /Root/Objects/Server/ServerStatus
    if {[info exists ::T($status)]} {
	if {[catch {opcua read C [lindex $::T($status) 0]} error]} {
	    log "reading server status: $error"
	    catch {opcua disconnect C}
	    log "reconnecting to $url"
	    if {[catch {opcua connect C $url} error]} {
		log "connect failed: $error"
	    }
	}
    }
    set now [clock seconds]
    foreach nodeid [array names ::D] {



	if {$::U($nodeid) <= 0 && $now - $::M($nodeid) >= 60} {
	    log "expire $::R($nodeid)"
	    unset -nocomplain ::D($nodeid)
	    unset -nocomplain ::M($nodeid)
	    unset -nocomplain ::U($nodeid)
	}
    }
    after 10000 [list fs_cleanup $url]
}

fs_cleanup $url

# Start event loop

log "enter event loop"
vwait forever