source: trunk/guitools/shared/smbtree.vrs@ 640

Last change on this file since 640 was 640, checked in by Herwig Bauernfeind, 14 years ago

GUI-Tools: EVFSGUI 2.5.x: More work done
File size: 21.5 KB
Line 
1/* Routines to handle smbtree output */
2
3/*:VRX */
4_RefreshTree:
5 say time()' _RefreshTree() started'
6 FirstRun = 0
7
8 ok = SysFileDelete(samba.!msg)
9
10 if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
11 if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
12 if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
13
14 say " UserCred="UserCred
15
16 /* smbtree -S = List workgroups (domains) and servers of tree */
17 say ' detach 'samba.!smbtreeexe' 'BroadCast' -S 'UserCred' 'debuglevel' >'samba.!msg
18 address cmd 'detach 'samba.!smbtreeexe' 'BroadCast' -S 'UserCred' 'debuglevel' >'samba.!msg
19
20 if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
21 if UserCred = '-N' then UserCred = ''
22
23 ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")
24
25 RefreshMode = "TREE"
26 ok = VRSet("CN_smbtree","Enabled", 0)
27 ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
28
29 say time()' _RefreshTree() done'
30return
31
32/*:VRX */
33_RefreshTreeDisplay:
34 say time()' _RefreshTreeDisplay() started'
35
36 stat = stream(samba.!msg,'c','open read')
37 if stat <> "READY:" then return
38
39 if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
40 if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
41 if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
42
43 ok = VRset("TM_RefreshTreeDisplay","Enabled",0)
44 ok = VRSet("CN_smbtree", 'Enabled', 0 )
45
46 ok = VRSet( "CN_smbtree", "Painting", 0 )
47 ok = VRMethod("CN_smbtree", "RemoveRecord", "ALL")
48
49 drop smbtree.
50
51 ok = file2stem(samba.!msg,"smbtreeline.")
52
53 do sl = 1 to smbtreeline.0
54 Header = c2x(left(smbtreeline.sl,3))
55 select
56 when Header = "09095C" then nop /* share - obsolete, we only list domains and servers here */
57 when Header = "095C5C" then do /* machine */
58 smbtreeline.sl = strip(smbtreeline.sl,,'09'x)
59 parse var smbtreeline.sl '\\'machine '0909'x comment
60 machine = strip(machine)
61 comment = strip(comment)
62 if VRGet("CN_smbtree","View") = "IconTree" then parent = smbtree.!workgroup; else parent = ""
63 /* We make any machine as sleeping initially */
64 smbtree.!machine = _AddSleepingMachine(machine,comment,parent)
65
66 ok = VRSet( "CN_smbtree", "Painting", 1 )
67 ok = VRSet( "CN_smbtree", "Painting", 0 )
68
69 if VRGet("CN_smbtree","View") <> "Detail" then do
70 /* Tree view */
71 call _RefreshShares
72 end
73 else do /* Fill records for details view */
74 ok = VRSet("Main", 'Pointer', 'Wait' )
75 /* Get all IP addresses of the machine */
76 IPStr = _GetMachineIP(machine)
77 ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr)
78 parse var IPStr MachineIP ',' .
79 if strip(MachineIP) = "" then MachineIP = machine
80 ok = VRSet("Main", 'Pointer', '<default>' )
81
82 /* Find out OS, version */
83 say ' 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'samba.!msg' 1>NUL'
84 address cmd samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'samba.!msg' 1>NUL'
85 smbline = linein(samba.!msg)
86 ok = stream(samba.!msg,'c','close')
87 parse var smbline "Domain=["WorkGroup"] OS=["OS"] Server=["Version"]"Rest
88 ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, OSFH, OS, VersionFH, Version, WorkgroupFH, WorkGroup)
89
90 /* Find out server role, MAC */
91 MACRoles = _GetMachineMACRoles(machineIP)
92 parse var MACRoles MAC '|' Roles; drop MACRoles
93 ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, MBFH, Roles, MacFH,MAC)
94 if pos("PDC",Roles) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#63:PMWP.DLL")
95 end
96 end
97 when smbtreeline.sl = "" then nop /* skip empty lines */
98 otherwise do /* possibly a new workgroup */
99 say ' Possible workgroup: "'smbtreeline.sl'"'
100 /* check for eventual error messages */
101 if pos("RECEIVING",translate(smbtreeline.sl)) > 0 | pos("TDB(",translate(smbtreeline.sl)) > 0 then do
102 Msg.Type = "W"
103 Msg.Text = smbtreeline.sl
104 call _ShowMsg
105 end
106 else do /* it is really a new workgroup */
107 if VRGet("CN_smbtree","View") = "IconTree" then do
108 smbtree.!workgroup = _AddWorkGroup(smbtreeline.sl)
109 end
110 CurWG = smbtreeline.sl
111 end
112 end
113 end
114 end
115
116 ok = VRSet( "CN_smbtree", "Painting", 1 )
117
118/* ok = VRSet("Main", 'Pointer', '<default>' ) */
119 ok = VRSet("CN_smbtree","Enabled", 1)
120 ok = VRSet("TM_Throbber","Enabled", 0)
121 ok = VRSet("Pict_Throbber","Visible", 0)
122 say time()' _RefreshTreeDisplay() done'
123return
124
125/*:VRX _RefreshShares */
126_RefreshShares:
127 say time()' _RefreshShares() started'
128
129 smbmachine = TempDir||"smbmachine."||machine
130 MaxSmbClient = 32 /* Do not run more than MaxSmbClient instances of smbclient.exe at the same time */
131
132 Defer = 1
133 do while Defer = 1
134 SmbCltCount = 0
135 ok = PRProcessList(proc)
136
137 do I = 1 to proc.0
138 CurProc = VRParseFileName(proc.i.name,'NE')
139 if CurProc = "SMBCLIENT.EXE" then SmbCltCount = SmbCltCount + 1
140 end
141 say ' 'SmbCltCount' instance(s) of 'samba.!smbclientexe' is/are running.'
142 if SmbCltCount >= MaxSmbClient then do
143 say " Waiting until at least "SmbCltCount-MaxSmbClient+1" instance(s) of smbclient.exe terminate(s)."
144 ok = SysSleep(1)
145 end
146 else Defer = 0
147 end
148
149 if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
150
151 say ' detach 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'smbmachine' 1>&2'
152 address cmd 'detach 'samba.!smbclientexe' -L "'machine'" 'UserCred' 'debuglevel' 2>'smbmachine' 1>&2'
153
154 if UserCred = '-N' then UserCred = ''
155
156 RefreshMode = "SHARE"
157
158 ok = VRSet("CN_smbtree","Enabled", 0)
159 ok = VRset("TM_RefreshTreeDisplay","Enabled",1)
160 say time()' _RefreshShares() done'
161return
162
163/*:VRX _AddSharesDisplay
164*/
165_AddSharesDisplay: /* New get shares code - uses smbclient output and is much faster */
166 say time()' _AddSharesDisplay() started'
167
168 ok = SysFileTree(Tempdir||'smbmachine.*',smbmachine.,'FO')
169 if smbmachine.0 = 0 then do /* we are done, no more files around, cleanup, disable Timer and exit */
170 RefreshMode = ""
171 ok = VRset("TM_RefreshTreeDisplay","Enabled",0)
172 ok = VRSet("CN_smbtree","Enabled", 1)
173 ok = VRSet("CN_smbtree", "Painting", 0 )
174 ok = VRSet("CN_smbtree", "Painting", 1 )
175 say time()' _AddSharesDisplay() completed'
176 return /* exit here */
177 end
178 else say ' 'smbmachine.0' file(s) to process.'
179
180 if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
181 if ShowHidden = 'SHOWHIDDEN' | ShowHidden = '' then ShowHidden = 0
182
183 do I = 1 to smbmachine.0
184 call charout , ' Going for "'smbmachine.I'", got '
185 if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", VRGet("DT_STATUSBAR","Caption")||'.')
186 stat = stream(smbmachine.I,'c','open read')
187 say '"'stat'"'
188
189 infoline = ""
190 if stat = "READY:" then do /* we found a readable output file */
191 OneWorkGroupOnly = 0
192
193 Machine = substr(smbmachine.I,pos('.',smbmachine.I)+1)
194
195 smbtree.!machine = _GetMachinehandle(Machine)
196
197 if smbtree.!machine = "" then do /* invalid (old) file */
198 say time()' _AddSharesDisplay() exit with Invalid file found (no corresponding machine)'
199 ok = stream(smbmachine.I,'c','close')
200 ok = SysFileDelete(smbmachine.I)
201 iterate
202 end
203 line = linein(smbmachine.I) /* PID line */
204 line = linein(smbmachine.I)
205 if pos('creating lame', line) > 0 then do
206 line = linein(smbmachine.I)
207 line = linein(smbmachine.I)
208 end
209 if pos('Server=[', line) > 0 then do
210 infoline = linein(smbmachine.I)
211 parse var infoline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest
212 ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, OSFH, OS, VersionFH, Server)
213 line = linein(smbmachine.I)
214 end
215 say ' Answer "'line'"'
216 ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER|"||strip(line))
217
218 if pos("FAIL", translate(line)) > 0 then do /* we see an error message - the term "FAIL" seems to be common to all */
219 say time()' _AddSharesDisplay() exit with "'line'"'
220 ok = stream(smbmachine.I,'c','close')
221 ok = SysFileDelete(smbmachine.I)
222 iterate
223 end
224
225 retries = 0
226 do while(left(line,1) <> '09'x)
227 line = linein(smbmachine.I)
228 retries = retries + 1
229 say ' Skip 'retries' "'line'"'
230 if retries >=10 then do /* No valid output - error */
231 say time()' _AddSharesDisplay() exit with invalid output error'
232 ok = stream(smbmachine.I,'c','close')
233 ok = SysFileDelete(smbmachine.I)
234 leave
235 end
236 end
237 if retries >=10 then iterate
238
239 /* Skip header */
240 line = linein(smbmachine.I)
241 line = linein(smbmachine.I)
242
243 if translate(left(strip(line),5)) = "ERROR" then ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'UserData', "SERVER|"||strip(line))
244
245 do while(left(line,1) = '09'x) /* Share loop */
246 parse var line '09'x share type comment
247 type = translate(strip(type))
248 comment = strip(comment)
249
250 select
251 when type = "DISK" then res = '#64:PMWP.DLL'
252 when type = "PRINTER" then res = '#65:PMWP.DLL'
253 when type = "IPC" then res = '#59:PMWP.DLL'
254 when type = "DEVICE" then res = '#84:PMWP.DLL' /* There might be better ones around */
255 otherwise res = ''
256 end
257
258 /* Now the machine receives the wakeup icon */
259 ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Icon', "#35:PMWP.DLL")
260 parent = smbtree.!machine
261 smbtree.!share = VRMethod( "CN_smbtree", "AddRecord",parent,, share||'0D0A'x||comment, res)
262 ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "ReadOnly", 1, 'UserData', type"|")
263 if pos("$", share) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!share, "Visible", ShowHidden)
264
265 /* get next share */
266 line = linein(smbmachine.I)
267 end /* Share loop */
268
269 do until left(line,10) = '09'x||'Workgroup'
270 line = linein(smbmachine.I)
271 end
272 line = linein(smbmachine.I)
273 /* Reading FIRST workgroup and master - eventually both empty */
274 line = linein(smbmachine.I)
275
276 /* Multiple workgroups? */
277 if lines(smbmachine.I) = 0 then OneWorkGroupOnly = 1
278 else OneWorkGroupOnly = 0
279 say " OneWorkGroupOnly = "OneWorkGroupOnly
280
281 parse var line '09'x workgroup master
282 master = strip(master)
283
284 /* we use this to set the workgroup for manually added servers - if there is ONLY ONE workgroup */
285 if workgroup <> "" & OneWorkGroupOnly = 1 then do
286 wgh = _GetMachinehandle(workgroup)
287 if wgh = "" then do /* The machine appears to be in a new workgroup - add it as well */
288 /* NOTE: This should be obsolete now because the list of available */
289 /* workgroups should always have been updated before we get here */
290 wgh = _AddWorkGroup(workgroup)
291 end
292 /* we only do this for machines with empty parent (=workgroup) handle */
293 /* IF there is only one workgroup */
294 if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" then do
295 ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
296 end
297 end
298 else do
299 if workgroup <> "" then do
300 /* There are multiple workgroups, we need additional */
301 /* measures to find out which is our workgroup */
302 if infoline <> "" then do
303 say ' 'samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
304 address cmd samba.!smbclientexe' -L "'Machine'" -N 'debuglevel' 2>'samba.!msg' 1>NUL'
305 infoline = linein(samba.!msg)
306
307 if word(infoline,1) = "creating" then do /* upcase tables are missing */
308 say "Missing upcase tables detected!"
309 infoline = linein(samba.!msg)
310 infoline = linein(samba.!msg)
311 end
312 IF options.!debug == 1 THEN say ' Response = "'Infoline'"'
313 ok = stream(samba.!msg,'c','close')
314 ok = SysFileDelete(samba.!msg)
315 end
316
317 parse var infoline "Domain=["WorkGroup"] OS=["OS"] Server=["Server"]"Rest
318
319 wgh = _GetMachinehandle(workgroup)
320 if wgh <> "" & VRMethod('CN_smbtree', 'GetRecordAttr', smbtree.!machine, 'Parent') = "" then do
321 ok = VRMethod('CN_smbtree', 'SetRecordAttr', smbtree.!machine, 'Parent', wgh)
322 end
323 end
324 else do
325 /* The machine does not allow browsing and does not report a workgroup here */
326 say ' "'Machine'" does not allow browsing.'
327 end
328 end
329
330 ok = VRSet("Main", 'Pointer', 'Wait' )
331 /* Find out IPs */
332 IPStr = _GetMachineIP(machine)
333 ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, IPFH, IPStr)
334 parse var IPStr MachineIP ',' .
335 if strip(MachineIP) = "" then MachineIP = machine
336 ok = VRSet("Main", 'Pointer', '<default>' )
337
338 /* Find out server role, MAC */
339 MACRoles = _GetMachineMACRoles(machineIP)
340 parse var MACRoles MAC '|' Roles; drop MACRoles
341 ok = VRMethod( "CN_smbtree", "SetFieldData", smbtree.!machine, MBFH, Roles, MacFH,MAC)
342 if pos("PDC",Roles) > 0 then ok = VRMethod( "CN_smbtree", "SetRecordAttr", smbtree.!machine, "Icon","#63:PMWP.DLL")
343
344 say time()' _AddSharesDisplay() success and cleanup'
345 ok = stream(smbmachine.I,'c','close')
346 ok = SysFileDelete(smbmachine.I)
347 if ok <> 0 then say ' Failure 'ok' deleting "'smbmachine.I'"!'
348 end
349 end
350
351 if UserCred = '-N' then UserCred = ''
352
353 if VRIsValidObject("DT_STATUSBAR") then ok = VRSet("DT_STATUSBAR","Caption", "Ready.")
354 say time()' _AddSharesDisplay() loop end'
355return
356
357/*:VRX _GetMachinehandle
358*/
359
360_GetMachinehandle: procedure /* get recordhandle by machine name (also works for workgroups) */
361 Machine = translate(arg(1))
362
363 ok = VRMethod("CN_smbtree", "GetRecordList", "All", rh.)
364 match = 0
365
366 do I = 1 to rh.0
367 ResName = translate(VRMethod("CN_smbtree","GetRecordAttr",rh.I,"Caption"))
368
369 parse var ResName ResName '0D0A'x .
370 ResName = strip(ResName)
371
372 if Machine = ResName then do /* we got a matching name */
373 match = 1
374 leave
375 end
376 end
377 if match = 0 then rh.I = "" /* return an empty handle, if there was no match */
378 say ' Handle for "'Machine'" = "'rh.I'"'
379return rh.I
380
381/*:VRX _RefreshWorkgroups
382*/
383_RefreshWorkgroups:
384 say time()' _RefreshWorkgroups() started'
385 if UserCred = 'USERCRED' | UserCred = '' | UserCred = '--user=%' then UserCred = '-N'
386 if BroadCast = 1 then BroadCast = '-b'; else BroadCast = ''
387
388 say ' 'samba.!smbtreeexe' 'BroadCast' -D 'debuglevel' 'UserCred' >'samba.!msg
389 address cmd samba.!smbtreeexe' 'BroadCast' -D 'debuglevel' 'UserCred' >'samba.!msg
390
391 if BroadCast = '-b' then BroadCast = 1; else BroadCast = 0
392 if UserCred = '-N' then UserCred = ''
393
394 ok = File2Stem(samba.!msg,"workgroups.")
395 do I = 1 to workgroups.0
396 workgroup = translate(workgroups.I)
397 if pos("RECEIVING",workgroup) > 0 | pos("TDB(",workgroup) > 0 then iterate /* We ignore errors here */
398 wgh = _GetMachinehandle(workgroup)
399 if wgh = "" then wgh = _AddWorkGroup(workgroup) /* A new workgroup was found -- add it */
400 end
401 say time()' _RefreshWorkgroups() done'
402return
403
404/*:VRX _AddWorkgroup
405*/
406_AddWorkGroup: procedure expose WorkGroupFH
407 workgroup = arg(1)
408 wgh= VRMethod( "CN_smbtree", "AddRecord",,, workgroup,"#62:PMWP.DLL")
409 ok = VRMethod( "CN_smbtree", "SetFieldData", wgh, WorkGroupFH, workgroup)
410 ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "Collapsed", 0)
411 ok = VRMethod( "CN_smbtree", "SetRecordAttr", wgh, "ReadOnly", 1)
412 ok = VRMethod( "CN_smbtree", 'SetRecordAttr', wgh, "UserData", "WORKGROUP|")
413return wgh
414
415/*:VRX _AddSleepingMachine
416*/
417_AddSleepingMachine: procedure expose WorkGroupFH NBFH CommentFH
418 machine = arg(1)
419 comment = arg(2)
420 parent = arg(3)
421 mh = VRMethod( "CN_smbtree", "AddRecord",parent,, machine||'0D0A'x||comment)
422 ok = VRMethod( "CN_smbtree", "SetFieldData", mh, NBFH, machine, CommentFH, comment)
423 ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "Icon","#61:PMWP.DLL")
424 ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "ReadOnly", 1)
425 ok = VRMethod( "CN_smbtree", "SetRecordAttr", mh, "Collapsed", 1)
426 ok = VRMethod( "CN_smbtree", 'SetRecordAttr', mh, "UserData", "SERVER|")
427 if parent <> "" then do
428 WGName = translate(VRMethod("CN_smbtree","GetRecordAttr",parent,"Caption"))
429 parse var WGName WGName '0D0A'x .
430 ok = VRMethod( "CN_smbtree", "SetFieldData", mh, WorkgroupFH, strip(WGName))
431 end
432return mh
433
434/*:VRX _GetMachineIP
435*/
436_GetMachineIP: procedure expose debuglevel samba.
437 /* Get all IP addresses of the machine */
438 machine = arg(1)
439 say ' 'samba.!nmblookupexe' 'machine' 'debuglevel' >'samba.!msg
440 address cmd samba.!nmblookupexe' 'machine' 'debuglevel' >'samba.!msg
441 ok = file2stem(samba.!msg,"nmblookup.")
442 ipstr = ""; ip = ""
443 do i = 1 to nmblookup.0
444 if pos(strip(machine)'<',nmblookup.i) = 0 then iterate
445 parse var nmblookup.i ip .
446 if pos(strip(ip), ipstr) = 0 then ipstr = ipstr||ip','
447 end
448 ipstr = strip(ipstr,,',')
449return IpStr
450
451/*:VRX _GetMachineRole
452*/
453_GetMachineMACRoles: procedure expose debuglevel samba.
454 machine = arg(1) /* May be name or IP */
455 say ' 'samba.!nmblookupexe' -A 'machine' 'debuglevel' >'samba.!msg
456 address cmd samba.!nmblookupexe' -A 'machine' 'debuglevel' >'samba.!msg
457 ok = file2stem(samba.!msg,"nmblookup.")
458 Roles = ""
459 MAC = 'xx-xx-xx-xx-xx-xx'
460 do I = 1 to nmblookup.0
461 select
462 when pos('<1c>', nmblookup.I) > 0 then Roles = Roles||"PDC," /* # */
463 when pos('<1b>', nmblookup.I) > 0 then Roles = Roles||"LMB," /* + */
464 when pos('<1d>', nmblookup.I) > 0 then Roles = Roles||"DMB," /* * */
465 when pos('MAC', nmblookup.I) > 0 then do
466 parse var nmblookup.I . '=' MAC
467 MAC = strip(MAC)
468 end
469 otherwise nop
470 end
471 end
472 Roles = strip(Roles,,',')
473 if Roles = "" then Roles = "Workstation"
474return MAC'|'Roles
475
476/*:VRX file2stem
477*/
478file2stem:
479 msgfile = arg(1)
480 msgstem = arg(2)
481 if right(msgstem,1) <> '.' then msgstem = msgstem'.'
482 say ' file2stem("'msgfile'","'msgstem'")'
483 dyn = 'drop 'msgstem
484 interpret dyn
485 stemcount = 0
486 do while lines(msgfile) > 0
487 stemcount = stemcount + 1
488 inline = linein(msgfile)
489 if pos('creating lame',inline) > 0 then do
490 stemcount = stemcount - 1
491 iterate
492 end
493 dyn = msgstem||stemcount' = inline'
494 interpret dyn
495 end
496 dyn = msgstem||"0 = "stemcount
497 interpret dyn
498 ok = stream(msgfile,'c','close')
499 ok = SysFileDelete(msgfile)
500 drop msgfile msgstem
501return stemcount
Note: See TracBrowser for help on using the repository browser.