1# -*- tcl -*- 2# ### ### ### ######### ######### ######### 3 4## This package provides custom plugin management specific to PAGE. It 5## is built on top of the generic plugin management framework (See 6## ---> pluginmgr). 7 8# ### ### ### ######### ######### ######### 9## Requisites 10 11package require fileutil 12package require pluginmgr ; # Generic plugin management framework 13 14namespace eval ::page::pluginmgr {} 15 16# ### ### ### ######### ######### ######### 17## API (Public, exported) 18 19proc ::page::pluginmgr::reportvia {cmd} { 20 variable reportcmd $cmd 21 return 22} 23 24proc ::page::pluginmgr::log {cmd} { 25 variable reader 26 variable writer 27 variable transforms 28 29 set iplist {} 30 lappend iplist [$reader interpreter] 31 lappend iplist [$writer interpreter] 32 foreach t $transforms { 33 lappend iplist [$t interpreter] 34 } 35 36 if {$cmd eq ""} { 37 # No logging. Disable with empty command, 38 # to allow the system to completely remove 39 # them from the bytecode (= No execution 40 # overhead). 41 42 foreach ip $iplist { 43 $ip eval [list proc page_log_error args {}] 44 $ip eval [list proc page_log_warning args {}] 45 $ip eval [list proc page_log_info args {}] 46 } 47 } else { 48 # Activate logging. Make the commands in 49 # the interpreters aliases to us. 50 51 foreach ip $iplist { 52 interp alias $ip page_log_error {} ${cmd}::error 53 interp alias $ip page_log_warning {} ${cmd}::warning 54 interp alias $ip page_log_info {} ${cmd}::info 55 } 56 } 57 return 58} 59 60proc ::page::pluginmgr::reader {name} { 61 variable reader 62 63 $reader load $name 64 return [$reader do page_roptions] 65} 66 67proc ::page::pluginmgr::rconfigure {dict} { 68 variable reader 69 foreach {k v} $dict { 70 $reader do page_rconfigure $k $v 71 } 72 return 73} 74 75proc ::page::pluginmgr::rtimeable {} { 76 variable reader 77 return [$reader do page_rfeature timeable] 78} 79 80proc ::page::pluginmgr::rtime {} { 81 variable reader 82 $reader do page_rtime 83 return 84} 85 86proc ::page::pluginmgr::rgettime {} { 87 variable reader 88 return [$reader do page_rgettime] 89} 90 91proc ::page::pluginmgr::rhelp {} { 92 variable reader 93 return [$reader do page_rhelp] 94} 95 96proc ::page::pluginmgr::rlabel {} { 97 variable reader 98 return [$reader do page_rlabel] 99} 100 101proc ::page::pluginmgr::read {read eof {complete {}}} { 102 variable reader 103 104 #interp alias $ip page_read {} {*}$read 105 #interp alias $ip page_eof {} {*}$eof 106 107 set ip [$reader interpreter] 108 eval [linsert $read 0 interp alias $ip page_read {}] 109 eval [linsert $eof 0 interp alias $ip page_eof {}] 110 111 if {![llength $complete]} { 112 interp alias $ip page_read_done {} ::page::pluginmgr::Nop 113 } else { 114 eval [linsert $complete 0 interp alias $ip page_read_done {}] 115 } 116 117 return [$reader do page_rrun] 118} 119 120proc ::page::pluginmgr::writer {name} { 121 variable writer 122 123 $writer load $name 124 return [$writer do page_woptions] 125} 126 127proc ::page::pluginmgr::wconfigure {dict} { 128 variable writer 129 foreach {k v} $dict { 130 $writer do page_wconfigure $k $v 131 } 132 return 133} 134 135proc ::page::pluginmgr::wtimeable {} { 136 variable writer 137 return [$writer do page_wfeature timeable] 138} 139 140proc ::page::pluginmgr::wtime {} { 141 variable writer 142 $writer do page_wtime 143 return 144} 145 146proc ::page::pluginmgr::wgettime {} { 147 variable writer 148 return [$writer do page_wgettime] 149} 150 151proc ::page::pluginmgr::whelp {} { 152 variable writer 153 return [$writer do page_whelp] 154} 155 156proc ::page::pluginmgr::wlabel {} { 157 variable writer 158 return [$writer do page_wlabel] 159} 160 161proc ::page::pluginmgr::write {chan data} { 162 variable writer 163 164 $writer do page_wrun $chan $data 165 return 166} 167 168proc ::page::pluginmgr::transform {name} { 169 variable transform 170 variable transforms 171 172 $transform load $name 173 174 set id [llength $transforms] 175 set opt [$transform do page_toptions] 176 lappend transforms [$transform clone] 177 178 return [list $id $opt] 179} 180 181proc ::page::pluginmgr::tconfigure {id dict} { 182 variable transforms 183 184 set t [lindex $transforms $id] 185 186 foreach {k v} $dict { 187 $t do page_tconfigure $k $v 188 } 189 return 190} 191 192proc ::page::pluginmgr::ttimeable {id} { 193 variable transforms 194 set t [lindex $transforms $id] 195 return [$t do page_tfeature timeable] 196} 197 198proc ::page::pluginmgr::ttime {id} { 199 variable transforms 200 set t [lindex $transforms $id] 201 $t do page_ttime 202 return 203} 204 205proc ::page::pluginmgr::tgettime {id} { 206 variable transforms 207 set t [lindex $transforms $id] 208 return [$t do page_tgettime] 209} 210 211proc ::page::pluginmgr::thelp {id} { 212 variable transforms 213 set t [lindex $transforms $id] 214 return [$t do page_thelp] 215} 216 217proc ::page::pluginmgr::tlabel {id} { 218 variable transforms 219 set t [lindex $transforms $id] 220 return [$t do page_tlabel] 221} 222 223proc ::page::pluginmgr::transform_do {id data} { 224 variable transforms 225 variable reader 226 227 set t [lindex $transforms $id] 228 229 return [$t do page_trun $data] 230} 231 232proc ::page::pluginmgr::configuration {name} { 233 variable config 234 235 if {[file exists $name]} { 236 # Try as plugin first. On failure read it as list of options, 237 # separated by spaces and tabs, and possibly quoted with 238 # quotes and double-quotes. 239 240 if {[catch {$config load $name}]} { 241 set ch [open $name r] 242 set options [::read $ch] 243 close $ch 244 245 set def {} 246 while {[string length $options]} { 247 if {[regsub "^\[ \t\n\]+" $options {} options]} { 248 # Skip whitespace 249 continue 250 } 251 if {[regexp -indices {^'(([^']|(''))*)'} \ 252 $options -> word]} { 253 foreach {__ end} $word break 254 lappend def [string map {'' '} [string range $options 1 $end]] 255 set options [string range $options [incr end 2] end] 256 } elseif {[regexp -indices {^"(([^"]|(""))*)"} \ 257 $options -> word]} { 258 foreach {__ end} $word break 259 lappend def [string map {{""} {"}} [string range $options 1 $end]] 260 set options [string range $options [incr end 2] end] 261 } elseif {[regexp -indices "^(\[^ \t\n\]+)" \ 262 $options -> word]} { 263 foreach {__ end} $word break 264 lappend def [string range $options 0 $end] 265 set options [string range $options [incr end] end] 266 } 267 } 268 return $def 269 } 270 } else { 271 $config load $name 272 } 273 set def [$config do page_cdefinition] 274 $config unload 275 return $def 276} 277 278proc ::page::pluginmgr::report {level text {from {}} {to {}}} { 279 variable replevel 280 variable reportcmd 281 uplevel #0 [linsert $reportcmd end $replevel($level) $text $from $to] 282 return 283} 284 285# ### ### ### ######### ######### ######### 286## Internals 287 288## Data structures 289## 290## - reader | Instances of pluginmgr configured for input, 291## - transform | transformational, and output plugins. The 292## - writer | manager for transforms is actually a template 293## | from which the actual instances are cloned. 294 295## - reportcmd | Callback for reporting of input error and warnings. 296## - replevel | Mapping from chosen level to the right-padded text 297## | to use. 298 299namespace eval ::page::pluginmgr { 300 variable replevel 301 array set replevel { 302 info {info } 303 warning {warning} 304 error {error } 305 } 306} 307 308proc ::page::pluginmgr::Initialize {} { 309 InitializeReporting 310 InitializeConfig 311 InitializeReader 312 InitializeTransform 313 InitializeWriter 314 return 315} 316 317proc ::page::pluginmgr::InitializeReader {} { 318 variable commands 319 variable reader_api 320 variable reader [pluginmgr RD \ 321 -setup ::page::pluginmgr::InitializeReaderIp \ 322 -pattern page::reader::* \ 323 -api $reader_api \ 324 -cmdip {} \ 325 -cmds $commands] 326 327 # The page_log_* commands are set later, when it is known if 328 # logging is active or not, as their implementation depends on 329 # this. 330 331 pluginmgr::paths $reader page::reader 332 return 333} 334 335proc ::page::pluginmgr::InitializeReaderIp {p ip} { 336 interp eval $ip { 337 # @sak notprovided page::plugin 338 # @sak notprovided page::plugin::reader 339 package provide page::plugin 1.0 340 package provide page::plugin::reader 1.0 341 } 342 interp alias $ip puts {} puts 343 interp alias $ip open {} ::page::pluginmgr::AliasOpen $ip 344 interp alias $ip write {} ::page::pluginmgr::WriteFile $ip 345 return 346} 347 348proc ::page::pluginmgr::InitializeWriter {} { 349 variable commands 350 variable writer_api 351 variable writer [pluginmgr WR \ 352 -setup ::page::pluginmgr::InitializeWriterIp \ 353 -pattern page::writer::* \ 354 -api $writer_api \ 355 -cmdip {} \ 356 -cmds $commands] 357 358 # The page_log_* commands are set later, when it is known if 359 # logging is active or not, as their implementation depends on 360 # this. 361 362 pluginmgr::paths $writer page::writer 363 return 364} 365 366proc ::page::pluginmgr::InitializeWriterIp {p ip} { 367 interp eval $ip { 368 # @sak notprovided page::plugin 369 # @sak notprovided page::plugin::writer 370 package provide page::plugin 1.0 371 package provide page::plugin::writer 1.0 372 } 373 interp alias $ip puts {} puts 374 interp alias $ip open {} ::page::pluginmgr::AliasOpen $ip 375 interp alias $ip write {} ::page::pluginmgr::WriteFile $ip 376 return 377} 378 379proc ::page::pluginmgr::InitializeTransform {} { 380 variable transforms {} 381 variable commands 382 variable transform_api 383 variable transform [pluginmgr TR \ 384 -setup ::page::pluginmgr::InitializeTransformIp \ 385 -pattern page::transform::* \ 386 -api $transform_api \ 387 -cmdip {} \ 388 -cmds $commands] 389 390 # The page_log_* commands are set later, when it is known if 391 # logging is active or not, as their implementation depends on 392 # this. 393 394 pluginmgr::paths $transform page::transform 395 return 396} 397 398proc ::page::pluginmgr::InitializeTransformIp {p ip} { 399 interp eval $ip { 400 # @sak notprovided page::plugin 401 # @sak notprovided page::plugin::transform 402 package provide page::plugin 1.0 403 package provide page::plugin::transform 1.0 404 } 405 interp alias $ip puts {} puts 406 interp alias $ip open {} ::page::pluginmgr::AliasOpen $ip 407 interp alias $ip write {} ::page::pluginmgr::WriteFile $ip 408 return 409} 410 411proc ::page::pluginmgr::InitializeConfig {} { 412 variable config [pluginmgr CO \ 413 -pattern page::config::* \ 414 -api {page_cdefinition}] 415 416 pluginmgr::paths $config page::config 417 return 418} 419 420proc ::page::pluginmgr::InitializeReporting {} { 421 variable reportcmd ::page::pluginmgr::ReportStderr 422 return 423} 424 425proc ::page::pluginmgr::ReportStderr {level text from to} { 426 # from = epsilon | list (line col) 427 # to = epsilon | list (line col) 428 # line = 5 digits, col = 3 digits 429 430 if { 431 ($text eq "") && 432 ![llength $from] && 433 ![llength $to] 434 } { 435 puts stderr "" 436 return 437 } 438 439 puts -nonewline stderr $level 440 WriteLocation $from 441 if {![llength $to]} { 442 puts -nonewline stderr { } 443 } else { 444 puts -nonewline stderr {-} 445 } 446 WriteLocation $to 447 puts -nonewline stderr " " 448 puts -nonewline stderr $text 449 puts stderr "" 450 return 451} 452 453proc ::page::pluginmgr::WriteLocation {loc} { 454 if {![llength $loc]} { 455 set text { } 456 } else { 457 set line [lindex $loc 0] 458 set col [lindex $loc 1] 459 set text {} 460 if {![string length $line]} { 461 append text _____ 462 } else { 463 append text [string map {{ } _} [format %5d $line]] 464 } 465 append text @ 466 if {![string length $col]} { 467 append text ___ 468 } else { 469 append text [string map {{ } _} [format %3d $col]] 470 } 471 } 472 puts -nonewline stderr $text 473 return 474} 475 476proc ::page::pluginmgr::AliasOpen {slave file {acc {}} {perm {}}} { 477 478 if {$acc eq ""} {set acc r} 479 480 ::safe::Log $slave ============================================= 481 ::safe::Log $slave "open $file $acc $perm" 482 483 if {[regexp {[wa+]|(WRONLY)|(RDWR)|(APPEND)|(CREAT)|(TRUNC)} $acc]} { 484 # Do not allow write acess. 485 ::safe::Log $slave "permission denied" 486 ::safe::Log $slave 0/============================================ 487 return -code error "permission denied" 488 } 489 490 if {[catch {set file [::safe::TranslatePath $slave $file]} msg]} { 491 ::safe::Log $slave $msg 492 ::safe::Log $slave "permission denied" 493 ::safe::Log $slave 1/============================================ 494 return -code error "permission denied" 495 } 496 497 # check that the path is in the access path of that slave 498 499 if {[catch {::safe::FileInAccessPath $slave $file} msg]} { 500 ::safe::Log $slave $msg 501 ::safe::Log $slave "permission denied" 502 ::safe::Log $slave 2/============================================ 503 return -code error "permission denied" 504 } 505 506 # do the checks on the filename : 507 508 if {[catch {::safe::CheckFileName $slave $file} msg]} { 509 ::safe::Log $slave "$file: $msg" 510 ::safe::Log $slave "$msg" 511 ::safe::Log $slave 3/============================================ 512 return -code error $msg 513 } 514 515 if {[catch {::interp invokehidden $slave open $file $acc} msg]} { 516 ::safe::Log $slave "Caught: $msg" 517 ::safe::Log $slave "script error" 518 ::safe::Log $slave 4/============================================ 519 return -code error "script error" 520 } 521 522 ::safe::Log $slave =/============================================ 523 return $msg 524 525} 526 527proc ::page::pluginmgr::Nop {args} {} 528 529proc ::page::pluginmgr::WriteFile {slave file text} { 530 if {[file pathtype $file] ne "relative"} { 531 set file [file join [pwd] [file tail $fail]] 532 } 533 file mkdir [file dirname $file] 534 fileutil::writeFile $file $text 535 return 536} 537 538# ### ### ### ######### ######### ######### 539## Initialization 540 541namespace eval ::page::pluginmgr { 542 543 # List of functions in the various plugin APIs 544 545 variable reader_api { 546 page_rhelp 547 page_rlabel 548 page_roptions 549 page_rconfigure 550 page_rrun 551 page_rfeature 552 } 553 variable writer_api { 554 page_whelp 555 page_wlabel 556 page_woptions 557 page_wconfigure 558 page_wrun 559 page_wfeature 560 } 561 variable transform_api { 562 page_thelp 563 page_tlabel 564 page_toptions 565 page_tconfigure 566 page_trun 567 page_tfeature 568 } 569 variable commands { 570 page_info {::page::pluginmgr::report info} 571 page_warning {::page::pluginmgr::report warning} 572 page_error {::page::pluginmgr::report error} 573 } 574} 575 576::page::pluginmgr::Initialize 577 578# ### ### ### ######### ######### ######### 579## Ready 580 581package provide page::pluginmgr 0.2 582