diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml index 8afaf4ad36e..0a693803dd3 100644 --- a/doc/src/sgml/pltcl.sgml +++ b/doc/src/sgml/pltcl.sgml @@ -902,51 +902,6 @@ if {[catch { spi_exec $sql_command }]} { - - Modules and the <function>unknown</> Command - - PL/Tcl has support for autoloading Tcl code when used. - It recognizes a special table, pltcl_modules, which - is presumed to contain modules of Tcl code. If this table - exists, the module unknown is fetched from the table - and loaded into the Tcl interpreter immediately before the first - execution of a PL/Tcl function in a database session. (This - happens separately for each Tcl interpreter, if more than one is - used in a session; see .) - - - While the unknown module could actually contain any - initialization script you need, it normally defines a Tcl - unknown procedure that is invoked whenever Tcl does - not recognize an invoked procedure name. PL/Tcl's standard version - of this procedure tries to find a module in pltcl_modules - that will define the required procedure. If one is found, it is - loaded into the interpreter, and then execution is allowed to - proceed with the originally attempted procedure call. A - secondary table pltcl_modfuncs provides an index of - which functions are defined by which modules, so that the lookup - is reasonably quick. - - - The PostgreSQL distribution includes - support scripts to maintain these tables: - pltcl_loadmod, pltcl_listmod, - pltcl_delmod, as well as source for the standard - unknown module in share/unknown.pltcl. This module - must be loaded - into each database initially to support the autoloading mechanism. - - - The tables pltcl_modules and pltcl_modfuncs - must be readable by all, but it is wise to make them owned and - writable only by the database administrator. As a security - precaution, PL/Tcl will ignore pltcl_modules (and thus, - not attempt to load the unknown module) unless it is - owned by a superuser. But update privileges on this table can be - granted to other users, if you trust them sufficiently. - - - Tcl Procedure Names diff --git a/src/pl/tcl/Makefile b/src/pl/tcl/Makefile index 25082ec5048..453e7ad2ecb 100644 --- a/src/pl/tcl/Makefile +++ b/src/pl/tcl/Makefile @@ -53,7 +53,6 @@ include $(top_srcdir)/src/Makefile.shlib all: all-lib - $(MAKE) -C modules $@ # Force this dependency to be known even without dependency info built: pltcl.o: pltclerrcodes.h @@ -65,14 +64,11 @@ pltclerrcodes.h: $(top_srcdir)/src/backend/utils/errcodes.txt generate-pltclerrc distprep: pltclerrcodes.h install: all install-lib install-data - $(MAKE) -C modules $@ installdirs: installdirs-lib $(MKDIR_P) '$(DESTDIR)$(datadir)/extension' - $(MAKE) -C modules $@ uninstall: uninstall-lib uninstall-data - $(MAKE) -C modules $@ install-data: installdirs $(INSTALL_DATA) $(addprefix $(srcdir)/, $(DATA)) '$(DESTDIR)$(datadir)/extension/' @@ -100,7 +96,6 @@ clean distclean: clean-lib ifeq ($(PORTNAME), win32) rm -f $(tclwithver).def endif - $(MAKE) -C modules $@ maintainer-clean: distclean rm -f pltclerrcodes.h diff --git a/src/pl/tcl/modules/.gitignore b/src/pl/tcl/modules/.gitignore deleted file mode 100644 index 89581887c48..00000000000 --- a/src/pl/tcl/modules/.gitignore +++ /dev/null @@ -1,3 +0,0 @@ -/pltcl_delmod -/pltcl_listmod -/pltcl_loadmod diff --git a/src/pl/tcl/modules/Makefile b/src/pl/tcl/modules/Makefile deleted file mode 100644 index 8055c61460f..00000000000 --- a/src/pl/tcl/modules/Makefile +++ /dev/null @@ -1,28 +0,0 @@ -# src/pl/tcl/modules/Makefile - -subdir = src/pl/tcl/modules -top_builddir = ../../../.. -include $(top_builddir)/src/Makefile.global - -MODULES = pltcl_loadmod pltcl_delmod pltcl_listmod - -all: $(MODULES) - -$(MODULES): %: %.in $(top_builddir)/src/Makefile.global - sed 's,@TCLSH@,$(TCLSH),g' $< >$@ - chmod a+x $@ - -install: all installdirs - $(INSTALL_SCRIPT) pltcl_loadmod '$(DESTDIR)$(bindir)/pltcl_loadmod' - $(INSTALL_SCRIPT) pltcl_delmod '$(DESTDIR)$(bindir)/pltcl_delmod' - $(INSTALL_SCRIPT) pltcl_listmod '$(DESTDIR)$(bindir)/pltcl_listmod' - $(INSTALL_DATA) $(srcdir)/unknown.pltcl '$(DESTDIR)$(datadir)/unknown.pltcl' - -installdirs: - $(MKDIR_P) '$(DESTDIR)$(bindir)' '$(DESTDIR)$(datadir)' - -uninstall: - rm -f '$(DESTDIR)$(bindir)/pltcl_loadmod' '$(DESTDIR)$(bindir)/pltcl_delmod' '$(DESTDIR)$(bindir)/pltcl_listmod' '$(DESTDIR)$(datadir)/unknown.pltcl' - -clean distclean maintainer-clean: - rm -f $(MODULES) diff --git a/src/pl/tcl/modules/README b/src/pl/tcl/modules/README deleted file mode 100644 index 342742c04be..00000000000 --- a/src/pl/tcl/modules/README +++ /dev/null @@ -1,18 +0,0 @@ -src/pl/tcl/modules/README - -Regular Tcl scripts of any size (over 8K :-) can be loaded into -the table pltcl_modules using the pltcl_loadmod script. The script -checks the modules that the procedure names don't overwrite -existing ones before doing anything. They also check for global -variables created at load time. - -All procedures defined in the module files are automatically -added to the table pltcl_modfuncs. This table is used by the -unknown procedure to determine if an unknown command can be -loaded by sourcing a module. In that case the unknown procedure -will silently source in the module and reexecute the original -command that invoked unknown. - -I know, this readme should be more explanatory - but time. - -Jan diff --git a/src/pl/tcl/modules/pltcl_delmod.in b/src/pl/tcl/modules/pltcl_delmod.in deleted file mode 100644 index daa4fac460b..00000000000 --- a/src/pl/tcl/modules/pltcl_delmod.in +++ /dev/null @@ -1,117 +0,0 @@ -#! /bin/sh -# src/pl/tcl/modules/pltcl_delmod.in -# -# Start tclsh \ -exec @TCLSH@ "$0" "$@" - -# -# Code still has to be documented -# - -#load /usr/local/pgsql/lib/libpgtcl.so -package require Pgtcl - - -# -# Check for minimum arguments -# -if {$argc < 1} { - puts stderr "" - puts stderr "usage: pltcl_delmod dbname \[options\] modulename \[...\]" - puts stderr "" - puts stderr "options:" - puts stderr " -host hostname" - puts stderr " -port portnumber" - puts stderr "" - exit 1 -} - -# -# Remember database name and initialize options -# -set dbname [lindex $argv 0] -set options "" -set errors 0 -set opt "" -set val "" - -set i 1 -while {$i < $argc} { - if {[string compare [string index [lindex $argv $i] 0] "-"] != 0} { - break; - } - - set opt [lindex $argv $i] - incr i - if {$i >= $argc} { - puts stderr "no value given for option $opt" - incr errors - continue - } - set val [lindex $argv $i] - incr i - - switch -- $opt { - -host { - append options "-host \"$val\" " - } - -port { - append options "-port $val " - } - default { - puts stderr "unknown option '$opt'" - incr errors - } - } -} - -# -# Final syntax check -# -if {$i >= $argc || $errors > 0} { - puts stderr "" - puts stderr "usage: pltcl_delmod dbname \[options\] modulename \[...\]" - puts stderr "" - puts stderr "options:" - puts stderr " -host hostname" - puts stderr " -port portnumber" - puts stderr "" - exit 1 -} - -proc delmodule {conn modname} { - set xname $modname - regsub -all {\\} $xname {\\} xname - regsub -all {'} $xname {''} xname - - set found 0 - pg_select $conn "select * from pltcl_modules where modname = '$xname'" \ - MOD { - set found 1 - break; - } - - if {!$found} { - puts "Module $modname not found in pltcl_modules" - puts "" - return - } - - pg_result \ - [pg_exec $conn "delete from pltcl_modules where modname = '$xname'"] \ - -clear - pg_result \ - [pg_exec $conn "delete from pltcl_modfuncs where modname = '$xname'"] \ - -clear - - puts "Module $modname removed" -} - -set conn [eval pg_connect $dbname $options] - -while {$i < $argc} { - delmodule $conn [lindex $argv $i] - incr i -} - -pg_disconnect $conn diff --git a/src/pl/tcl/modules/pltcl_listmod.in b/src/pl/tcl/modules/pltcl_listmod.in deleted file mode 100644 index 7d930ff0ea5..00000000000 --- a/src/pl/tcl/modules/pltcl_listmod.in +++ /dev/null @@ -1,123 +0,0 @@ -#! /bin/sh -# src/pl/tcl/modules/pltcl_listmod.in -# -# Start tclsh \ -exec @TCLSH@ "$0" "$@" - -# -# Code still has to be documented -# - -#load /usr/local/pgsql/lib/libpgtcl.so -package require Pgtcl - - -# -# Check for minimum arguments -# -if {$argc < 1} { - puts stderr "" - puts stderr "usage: pltcl_listmod dbname \[options\] \[modulename \[...\]\]" - puts stderr "" - puts stderr "options:" - puts stderr " -host hostname" - puts stderr " -port portnumber" - puts stderr "" - exit 1 -} - -# -# Remember database name and initialize options -# -set dbname [lindex $argv 0] -set options "" -set errors 0 -set opt "" -set val "" - -set i 1 -while {$i < $argc} { - if {[string compare [string index [lindex $argv $i] 0] "-"] != 0} { - break; - } - - set opt [lindex $argv $i] - incr i - if {$i >= $argc} { - puts stderr "no value given for option $opt" - incr errors - continue - } - set val [lindex $argv $i] - incr i - - switch -- $opt { - -host { - append options "-host \"$val\" " - } - -port { - append options "-port $val " - } - default { - puts stderr "unknown option '$opt'" - incr errors - } - } -} - -# -# Final syntax check -# -if {$errors > 0} { - puts stderr "" - puts stderr "usage: pltcl_listmod dbname \[options\] \[modulename \[...\]\]" - puts stderr "" - puts stderr "options:" - puts stderr " -host hostname" - puts stderr " -port portnumber" - puts stderr "" - exit 1 -} - -proc listmodule {conn modname} { - set xname $modname - regsub -all {\\} $xname {\\} xname - regsub -all {'} $xname {''} xname - - set found 0 - pg_select $conn "select * from pltcl_modules where modname = '$xname'" \ - MOD { - set found 1 - break; - } - - if {!$found} { - puts "Module $modname not found in pltcl_modules" - puts "" - return - } - - puts "Module $modname defines procedures:" - pg_select $conn "select funcname from pltcl_modfuncs \ - where modname = '$xname' order by funcname" FUNC { - puts " $FUNC(funcname)" - } - puts "" -} - -set conn [eval pg_connect $dbname $options] - -if {$i == $argc} { - pg_select $conn "select distinct modname from pltcl_modules \ - order by modname" \ - MOD { - listmodule $conn $MOD(modname) - } -} else { - while {$i < $argc} { - listmodule $conn [lindex $argv $i] - incr i - } -} - -pg_disconnect $conn diff --git a/src/pl/tcl/modules/pltcl_loadmod.in b/src/pl/tcl/modules/pltcl_loadmod.in deleted file mode 100644 index 645c6bbd9cf..00000000000 --- a/src/pl/tcl/modules/pltcl_loadmod.in +++ /dev/null @@ -1,501 +0,0 @@ -#! /bin/sh -# Start tclsh \ -exec @TCLSH@ "$0" "$@" - -# -# Code still has to be documented -# - -#load /usr/local/pgsql/lib/libpgtcl.so -package require Pgtcl - - -# -# Check for minimum arguments -# -if {$argc < 2} { - puts stderr "" - puts stderr "usage: pltcl_loadmod dbname \[options\] file \[...\]" - puts stderr "" - puts stderr "options:" - puts stderr " -host hostname" - puts stderr " -port portnumber" - puts stderr "" - exit 1 -} - -# -# Remember database name and initialize options -# -set dbname [lindex $argv 0] -set options "" -set errors 0 -set opt "" -set val "" - -set i 1 -while {$i < $argc} { - if {[string compare [string index [lindex $argv $i] 0] "-"] != 0} { - break; - } - - set opt [lindex $argv $i] - incr i - if {$i >= $argc} { - puts stderr "no value given for option $opt" - incr errors - continue - } - set val [lindex $argv $i] - incr i - - switch -- $opt { - -host { - append options "-host \"$val\" " - } - -port { - append options "-port $val " - } - default { - puts stderr "unknown option '$opt'" - incr errors - } - } -} - -# -# Final syntax check -# -if {$i >= $argc || $errors > 0} { - puts stderr "" - puts stderr "usage: pltcl_loadmod dbname \[options\] file \[...\]" - puts stderr "" - puts stderr "options:" - puts stderr " -host hostname" - puts stderr " -port portnumber" - puts stderr "" - exit 1 -} - - -proc __PLTcl_loadmod_check_table {conn tabname expnames exptypes} { - set attrs [expr [llength $expnames] - 1] - set error 0 - set found 0 - - pg_select $conn "select C.relname, A.attname, A.attnum, T.typname \ - from pg_catalog.pg_class C, pg_catalog.pg_attribute A, pg_catalog.pg_type T \ - where C.relname = '$tabname' \ - and A.attrelid = C.oid \ - and A.attnum > 0 \ - and T.oid = A.atttypid \ - order by attnum" tup { - - incr found - set i $tup(attnum) - - if {$i > $attrs} { - puts stderr "Table $tabname has extra field '$tup(attname)'" - incr error - continue - } - - set xname [lindex $expnames $i] - set xtype [lindex $exptypes $i] - - if {[string compare $tup(attname) $xname] != 0} { - puts stderr "Attribute $i of $tabname has wrong name" - puts stderr " got '$tup(attname)' expected '$xname'" - incr error - } - if {[string compare $tup(typname) $xtype] != 0} { - puts stderr "Attribute $i of $tabname has wrong type" - puts stderr " got '$tup(typname)' expected '$xtype'" - incr error - } - } - - if {$found == 0} { - return 0 - } - - if {$found < $attrs} { - incr found - set miss [lrange $expnames $found end] - puts "Table $tabname doesn't have field(s) $miss" - incr error - } - - if {$error > 0} { - return 2 - } - - return 1 -} - - -proc __PLTcl_loadmod_check_tables {conn} { - upvar #0 __PLTcl_loadmod_status status - - set error 0 - - set names {{} modname modseq modsrc} - set types {{} name int2 text} - - switch [__PLTcl_loadmod_check_table $conn pltcl_modules $names $types] { - 0 { - set status(create_table_modules) 1 - } - 1 { - set status(create_table_modules) 0 - } - 2 { - puts "Error(s) in table pltcl_modules" - incr error - } - } - - set names {{} funcname modname} - set types {{} name name} - - switch [__PLTcl_loadmod_check_table $conn pltcl_modfuncs $names $types] { - 0 { - set status(create_table_modfuncs) 1 - } - 1 { - set status(create_table_modfuncs) 0 - } - 2 { - puts "Error(s) in table pltcl_modfuncs" - incr error - } - } - - if {$status(create_table_modfuncs) && !$status(create_table_modules)} { - puts stderr "Table pltcl_modfuncs doesn't exist but pltcl_modules does" - puts stderr "Either both tables must be present or none." - incr error - } - - if {$status(create_table_modules) && !$status(create_table_modfuncs)} { - puts stderr "Table pltcl_modules doesn't exist but pltcl_modfuncs does" - puts stderr "Either both tables must be present or none." - incr error - } - - if {$error} { - puts stderr "" - puts stderr "Abort" - exit 1 - } - - if {!$status(create_table_modules)} { - __PLTcl_loadmod_read_current $conn - } -} - - -proc __PLTcl_loadmod_read_current {conn} { - upvar #0 __PLTcl_loadmod_status status - upvar #0 __PLTcl_loadmod_modsrc modsrc - upvar #0 __PLTcl_loadmod_funclist funcs - upvar #0 __PLTcl_loadmod_globlist globs - - set errors 0 - - set curmodlist "" - pg_select $conn "select distinct modname from pltcl_modules" mtup { - set mname $mtup(modname); - lappend curmodlist $mname - } - - foreach mname $curmodlist { - set srctext "" - pg_select $conn "select * from pltcl_modules \ - where modname = '$mname' \ - order by modseq" tup { - append srctext $tup(modsrc) - } - - if {[catch { - __PLTcl_loadmod_analyze \ - "Current $mname" \ - $mname \ - $srctext new_globals new_functions - }]} { - incr errors - } - set modsrc($mname) $srctext - set funcs($mname) $new_functions - set globs($mname) $new_globals - } - - if {$errors} { - puts stderr "" - puts stderr "Abort" - exit 1 - } -} - - -proc __PLTcl_loadmod_analyze {modinfo modname srctext v_globals v_functions} { - upvar 1 $v_globals new_g - upvar 1 $v_functions new_f - upvar #0 __PLTcl_loadmod_allfuncs allfuncs - upvar #0 __PLTcl_loadmod_allglobs allglobs - - set errors 0 - - set old_g [info globals] - set old_f [info procs] - set new_g "" - set new_f "" - - if {[catch { - uplevel #0 "$srctext" - } msg]} { - puts "$modinfo: $msg" - incr errors - } - - set cur_g [info globals] - set cur_f [info procs] - - foreach glob $cur_g { - if {[lsearch -exact $old_g $glob] >= 0} { - continue - } - if {[info exists allglobs($glob)]} { - puts stderr "$modinfo: Global $glob previously used in module $allglobs($glob)" - incr errors - } else { - set allglobs($glob) $modname - } - lappend new_g $glob - uplevel #0 unset $glob - } - foreach func $cur_f { - if {[lsearch -exact $old_f $func] >= 0} { - continue - } - if {[info exists allfuncs($func)]} { - puts stderr "$modinfo: Function $func previously defined in module $allfuncs($func)" - incr errors - } else { - set allfuncs($func) $modname - } - lappend new_f $func - rename $func {} - } - - if {$errors} { - return -code error - } - #puts "globs in $modname: $new_g" - #puts "funcs in $modname: $new_f" -} - - -proc __PLTcl_loadmod_create_tables {conn} { - upvar #0 __PLTcl_loadmod_status status - - if {$status(create_table_modules)} { - if {[catch { - set res [pg_exec $conn \ - "create table pltcl_modules ( \ - modname name, \ - modseq int2, \ - modsrc text);"] - } msg]} { - puts stderr "Error creating table pltcl_modules" - puts stderr " $msg" - exit 1 - } - if {[catch { - set res [pg_exec $conn \ - "create index pltcl_modules_i \ - on pltcl_modules using btree \ - (modname name_ops);"] - } msg]} { - puts stderr "Error creating index pltcl_modules_i" - puts stderr " $msg" - exit 1 - } - puts "Table pltcl_modules created" - pg_result $res -clear - } - - if {$status(create_table_modfuncs)} { - if {[catch { - set res [pg_exec $conn \ - "create table pltcl_modfuncs ( \ - funcname name, \ - modname name);"] - } msg]} { - puts stderr "Error creating table pltcl_modfuncs" - puts stderr " $msg" - exit 1 - } - if {[catch { - set res [pg_exec $conn \ - "create index pltcl_modfuncs_i \ - on pltcl_modfuncs using hash \ - (funcname name_ops);"] - } msg]} { - puts stderr "Error creating index pltcl_modfuncs_i" - puts stderr " $msg" - exit 1 - } - puts "Table pltcl_modfuncs created" - pg_result $res -clear - } -} - - -proc __PLTcl_loadmod_read_new {conn} { - upvar #0 __PLTcl_loadmod_status status - upvar #0 __PLTcl_loadmod_modsrc modsrc - upvar #0 __PLTcl_loadmod_funclist funcs - upvar #0 __PLTcl_loadmod_globlist globs - upvar #0 __PLTcl_loadmod_allfuncs allfuncs - upvar #0 __PLTcl_loadmod_allglobs allglobs - upvar #0 __PLTcl_loadmod_modlist modlist - - set errors 0 - - set new_modlist "" - foreach modfile $modlist { - set modname [file rootname [file tail $modfile]] - if {[catch { - set fid [open $modfile "r"] - } msg]} { - puts stderr $msg - incr errors - continue - } - set srctext [read $fid] - close $fid - - if {[info exists modsrc($modname)]} { - if {[string compare $modsrc($modname) $srctext] == 0} { - puts "Module $modname unchanged - ignored" - continue - } - foreach func $funcs($modname) { - unset allfuncs($func) - } - foreach glob $globs($modname) { - unset allglobs($glob) - } - unset funcs($modname) - unset globs($modname) - set modsrc($modname) $srctext - lappend new_modlist $modname - } else { - set modsrc($modname) $srctext - lappend new_modlist $modname - } - - if {[catch { - __PLTcl_loadmod_analyze "New/updated $modname" \ - $modname $srctext new_globals new_funcs - }]} { - incr errors - } - - set funcs($modname) $new_funcs - set globs($modname) $new_globals - } - - if {$errors} { - puts stderr "" - puts stderr "Abort" - exit 1 - } - - set modlist $new_modlist -} - - -proc __PLTcl_loadmod_load_modules {conn} { - upvar #0 __PLTcl_loadmod_modsrc modsrc - upvar #0 __PLTcl_loadmod_funclist funcs - upvar #0 __PLTcl_loadmod_modlist modlist - - set errors 0 - - foreach modname $modlist { - set xname [__PLTcl_loadmod_quote $modname] - - pg_result [pg_exec $conn "begin;"] -clear - - pg_result [pg_exec $conn \ - "delete from pltcl_modules where modname = '$xname'"] -clear - pg_result [pg_exec $conn \ - "delete from pltcl_modfuncs where modname = '$xname'"] -clear - - foreach func $funcs($modname) { - set xfunc [__PLTcl_loadmod_quote $func] - pg_result [ \ - pg_exec $conn "insert into pltcl_modfuncs values ( \ - '$xfunc', '$xname')" \ - ] -clear - } - set i 0 - set srctext $modsrc($modname) - while {[string compare $srctext ""] != 0} { - set xpart [string range $srctext 0 3999] - set xpart [__PLTcl_loadmod_quote $xpart] - set srctext [string range $srctext 4000 end] - - pg_result [ \ - pg_exec $conn "insert into pltcl_modules values ( \ - '$xname', $i, '$xpart')" \ - ] -clear - incr i - } - - pg_result [pg_exec $conn "commit;"] -clear - - puts "Successfully loaded/updated module $modname" - } -} - - -proc __PLTcl_loadmod_quote {s} { - regsub -all {\\} $s {\\\\} s - regsub -all {'} $s {''} s - return $s -} - - -set __PLTcl_loadmod_modlist [lrange $argv $i end] -set __PLTcl_loadmod_modsrc(dummy) "" -set __PLTcl_loadmod_funclist(dummy) "" -set __PLTcl_loadmod_globlist(dummy) "" -set __PLTcl_loadmod_allfuncs(dummy) "" -set __PLTcl_loadmod_allglobs(dummy) "" - -unset __PLTcl_loadmod_modsrc(dummy) -unset __PLTcl_loadmod_funclist(dummy) -unset __PLTcl_loadmod_globlist(dummy) -unset __PLTcl_loadmod_allfuncs(dummy) -unset __PLTcl_loadmod_allglobs(dummy) - - -puts "" - -set __PLTcl_loadmod_conn [eval pg_connect $dbname $options] - -unset i dbname options errors opt val - -__PLTcl_loadmod_check_tables $__PLTcl_loadmod_conn - -__PLTcl_loadmod_read_new $__PLTcl_loadmod_conn - -__PLTcl_loadmod_create_tables $__PLTcl_loadmod_conn -__PLTcl_loadmod_load_modules $__PLTcl_loadmod_conn - -pg_disconnect $__PLTcl_loadmod_conn - -puts "" diff --git a/src/pl/tcl/modules/unknown.pltcl b/src/pl/tcl/modules/unknown.pltcl deleted file mode 100644 index 0729ac1b702..00000000000 --- a/src/pl/tcl/modules/unknown.pltcl +++ /dev/null @@ -1,63 +0,0 @@ -#--------------------------------------------------------------------- -# Support for unknown command -#--------------------------------------------------------------------- - -proc unknown {proname args} { - upvar #0 __PLTcl_unknown_support_plan_modname p_mod - upvar #0 __PLTcl_unknown_support_plan_modsrc p_src - - #----------------------------------------------------------- - # On first call prepare the plans - #----------------------------------------------------------- - if {![info exists p_mod]} { - set p_mod [spi_prepare \ - "select modname from pltcl_modfuncs \ - where funcname = \$1" name] - set p_src [spi_prepare \ - "select modseq, modsrc from pltcl_modules \ - where modname = \$1 \ - order by modseq" name] - } - - #----------------------------------------------------------- - # Lookup the requested function in pltcl_modfuncs - #----------------------------------------------------------- - set n [spi_execp -count 1 $p_mod [list [quote $proname]]] - if {$n != 1} { - #----------------------------------------------------------- - # Not found there either - now it's really unknown - #----------------------------------------------------------- - return -code error "unknown command '$proname'" - } - - #----------------------------------------------------------- - # Collect the source pieces from pltcl_modules - #----------------------------------------------------------- - set src "" - spi_execp $p_src [list [quote $modname]] { - append src $modsrc - } - - #----------------------------------------------------------- - # Load the source into the interpreter - #----------------------------------------------------------- - if {[catch { - uplevel #0 "$src" - } msg]} { - elog NOTICE "pltcl unknown: error while loading module $modname" - elog WARN $msg - } - - #----------------------------------------------------------- - # This should never happen - #----------------------------------------------------------- - if {[catch {info args $proname}]} { - return -code error \ - "unknown command '$proname' (still after loading module $modname)" - } - - #----------------------------------------------------------- - # Finally simulate the initial procedure call - #----------------------------------------------------------- - return [uplevel 1 $proname $args] -} diff --git a/src/pl/tcl/pltcl.c b/src/pl/tcl/pltcl.c index ec5b54ab324..11faa6defe5 100644 --- a/src/pl/tcl/pltcl.c +++ b/src/pl/tcl/pltcl.c @@ -255,7 +255,6 @@ void _PG_init(void); static void pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted); static pltcl_interp_desc *pltcl_fetch_interp(bool pltrusted); -static void pltcl_init_load_unknown(Tcl_Interp *interp); static Datum pltcl_handler(PG_FUNCTION_ARGS, bool pltrusted); @@ -491,11 +490,6 @@ pltcl_init_interp(pltcl_interp_desc *interp_desc, bool pltrusted) pltcl_SPI_execute_plan, NULL, NULL); Tcl_CreateObjCommand(interp, "spi_lastoid", pltcl_SPI_lastoid, NULL, NULL); - - /************************************************************ - * Try to load the unknown procedure from pltcl_modules - ************************************************************/ - pltcl_init_load_unknown(interp); } /********************************************************************** @@ -526,126 +520,6 @@ pltcl_fetch_interp(bool pltrusted) return interp_desc; } -/********************************************************************** - * pltcl_init_load_unknown() - Load the unknown procedure from - * table pltcl_modules (if it exists) - **********************************************************************/ -static void -pltcl_init_load_unknown(Tcl_Interp *interp) -{ - Relation pmrel; - char *pmrelname, - *nspname; - char *buf; - int buflen; - int spi_rc; - int tcl_rc; - Tcl_DString unknown_src; - char *part; - uint64 i; - int fno; - - /************************************************************ - * Check if table pltcl_modules exists - * - * We allow the table to be found anywhere in the search_path. - * This is for backwards compatibility. To ensure that the table - * is trustworthy, we require it to be owned by a superuser. - ************************************************************/ - pmrel = relation_openrv_extended(makeRangeVar(NULL, "pltcl_modules", -1), - AccessShareLock, true); - if (pmrel == NULL) - return; - /* sanity-check the relation kind */ - if (!(pmrel->rd_rel->relkind == RELKIND_RELATION || - pmrel->rd_rel->relkind == RELKIND_MATVIEW || - pmrel->rd_rel->relkind == RELKIND_VIEW)) - { - relation_close(pmrel, AccessShareLock); - return; - } - /* must be owned by superuser, else ignore */ - if (!superuser_arg(pmrel->rd_rel->relowner)) - { - relation_close(pmrel, AccessShareLock); - return; - } - /* get fully qualified table name for use in select command */ - nspname = get_namespace_name(RelationGetNamespace(pmrel)); - if (!nspname) - elog(ERROR, "cache lookup failed for namespace %u", - RelationGetNamespace(pmrel)); - pmrelname = quote_qualified_identifier(nspname, - RelationGetRelationName(pmrel)); - - /************************************************************ - * Read all the rows from it where modname = 'unknown', - * in the order of modseq - ************************************************************/ - buflen = strlen(pmrelname) + 100; - buf = (char *) palloc(buflen); - snprintf(buf, buflen, - "select modsrc from %s where modname = 'unknown' order by modseq", - pmrelname); - - spi_rc = SPI_execute(buf, false, 0); - if (spi_rc != SPI_OK_SELECT) - elog(ERROR, "select from pltcl_modules failed"); - - pfree(buf); - - /************************************************************ - * If there's nothing, module unknown doesn't exist - ************************************************************/ - if (SPI_processed == 0) - { - SPI_freetuptable(SPI_tuptable); - ereport(WARNING, - (errmsg("module \"unknown\" not found in pltcl_modules"))); - relation_close(pmrel, AccessShareLock); - return; - } - - /************************************************************ - * There is a module named unknown. Reassemble the - * source from the modsrc attributes and evaluate - * it in the Tcl interpreter - * - * leave this code as DString - it's only executed once per session - ************************************************************/ - fno = SPI_fnumber(SPI_tuptable->tupdesc, "modsrc"); - Assert(fno > 0); - - Tcl_DStringInit(&unknown_src); - - for (i = 0; i < SPI_processed; i++) - { - part = SPI_getvalue(SPI_tuptable->vals[i], - SPI_tuptable->tupdesc, fno); - if (part != NULL) - { - UTF_BEGIN; - Tcl_DStringAppend(&unknown_src, UTF_E2U(part), -1); - UTF_END; - pfree(part); - } - } - tcl_rc = Tcl_EvalEx(interp, Tcl_DStringValue(&unknown_src), - Tcl_DStringLength(&unknown_src), - TCL_EVAL_GLOBAL); - - Tcl_DStringFree(&unknown_src); - SPI_freetuptable(SPI_tuptable); - - if (tcl_rc != TCL_OK) - ereport(ERROR, - (errcode(ERRCODE_EXTERNAL_ROUTINE_EXCEPTION), - errmsg("could not load module \"unknown\": %s", - utf_u2e(Tcl_GetStringResult(interp))))); - - relation_close(pmrel, AccessShareLock); -} - /********************************************************************** * pltcl_call_handler - This is the only visible function