From 817f2a586342767d3289a320bb1dac5dcbb76979 Mon Sep 17 00:00:00 2001 From: Tom Lane Date: Mon, 27 Feb 2017 11:20:22 -0500 Subject: [PATCH] Remove PL/Tcl's "module" facility. PL/Tcl has long had a facility whereby Tcl code could be autoloaded from a database table named "pltcl_modules". However, nobody is using it, as evidenced by the recent discovery that it's never been fixed to work with standard_conforming_strings turned on. Moreover, it's rather shaky from a security standpoint, and the table design is very old and crufty (partly because it dates from before we had TOAST). A final problem is that because the table-population scripts depend on the Tcl client library Pgtcl, which we removed from the core distribution in 2004, it's impossible to create a self-contained regression test for the feature. Rather than try to surmount these problems, let's just remove it. A follow-on patch will provide a way to execute user-defined initialization code, similar to features that exist in plperl and plv8. With that, it will be possible to implement this feature or similar ones entirely in userspace, which is where it belongs. Discussion: https://postgr.es/m/22067.1488046447@sss.pgh.pa.us --- doc/src/sgml/pltcl.sgml | 45 --- src/pl/tcl/Makefile | 5 - src/pl/tcl/modules/.gitignore | 3 - src/pl/tcl/modules/Makefile | 28 -- src/pl/tcl/modules/README | 18 - src/pl/tcl/modules/pltcl_delmod.in | 117 ------- src/pl/tcl/modules/pltcl_listmod.in | 123 ------- src/pl/tcl/modules/pltcl_loadmod.in | 501 ---------------------------- src/pl/tcl/modules/unknown.pltcl | 63 ---- src/pl/tcl/pltcl.c | 126 ------- 10 files changed, 1029 deletions(-) delete mode 100644 src/pl/tcl/modules/.gitignore delete mode 100644 src/pl/tcl/modules/Makefile delete mode 100644 src/pl/tcl/modules/README delete mode 100644 src/pl/tcl/modules/pltcl_delmod.in delete mode 100644 src/pl/tcl/modules/pltcl_listmod.in delete mode 100644 src/pl/tcl/modules/pltcl_loadmod.in delete mode 100644 src/pl/tcl/modules/unknown.pltcl diff --git a/doc/src/sgml/pltcl.sgml b/doc/src/sgml/pltcl.sgml index 8afaf4ad36..0a693803dd 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 25082ec504..453e7ad2ec 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 89581887c4..0000000000 --- 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 8055c61460..0000000000 --- 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 342742c04b..0000000000 --- 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 daa4fac460..0000000000 --- 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 7d930ff0ea..0000000000 --- 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 645c6bbd9c..0000000000 --- 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 0729ac1b70..0000000000 --- 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 ec5b54ab32..11faa6defe 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 -- 2.40.0