Skip to content

P
Postgres FD Implementation
Commit 817f2a58 authored by Tom Lane's avatar Tom Lane
Browse files
Options

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
parent 2ed193c9
Show whitespace changes
Inline Side-by-side
Showing with 0 additions and 1029 deletions
doc/src/sgml/pltcl.sgml
View file @ 817f2a58
......@@ -902,51 +902,6 @@ if {[catch { spi_exec $sql_command }]} {
</para>
</sect1>
<sect1 id="pltcl-unknown">
<title>Modules and the <function>unknown</> Command</title>
<para>
PL/Tcl has support for autoloading Tcl code when used.
It recognizes a special table, <literal>pltcl_modules</>, which
is presumed to contain modules of Tcl code. If this table
exists, the module <literal>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 <xref linkend="pltcl-global">.)
</para>
<para>
While the <literal>unknown</> module could actually contain any
initialization script you need, it normally defines a Tcl
<function>unknown</> procedure that is invoked whenever Tcl does
not recognize an invoked procedure name. <application>PL/Tcl</>'s standard version
of this procedure tries to find a module in <literal>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 <literal>pltcl_modfuncs</> provides an index of
which functions are defined by which modules, so that the lookup
is reasonably quick.
</para>
<para>
The <productname>PostgreSQL</productname> distribution includes
support scripts to maintain these tables:
<command>pltcl_loadmod</>, <command>pltcl_listmod</>,
<command>pltcl_delmod</>, as well as source for the standard
<literal>unknown</> module in <filename>share/unknown.pltcl</>. This module
must be loaded
into each database initially to support the autoloading mechanism.
</para>
<para>
The tables <literal>pltcl_modules</> and <literal>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 <literal>pltcl_modules</> (and thus,
not attempt to load the <literal>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.
</para>
</sect1>
<sect1 id="pltcl-procnames">
<title>Tcl Procedure Names</title>
......
src/pl/tcl/Makefile
View file @ 817f2a58
......@@ -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
src/pl/tcl/modules/.gitignore deleted 100644 → 0
View file @ 2ed193c9
/pltcl_delmod
/pltcl_listmod
/pltcl_loadmod
src/pl/tcl/modules/Makefile deleted 100644 → 0
View file @ 2ed193c9
# 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)
src/pl/tcl/modules/README deleted 100644 → 0
View file @ 2ed193c9
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
src/pl/tcl/modules/pltcl_delmod.in deleted 100644 → 0
View file @ 2ed193c9
#! /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
src/pl/tcl/modules/pltcl_listmod.in deleted 100644 → 0
View file @ 2ed193c9
#! /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
src/pl/tcl/modules/pltcl_loadmod.in deleted 100644 → 0
View file @ 2ed193c9
#! /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 ""
src/pl/tcl/modules/unknown.pltcl deleted 100644 → 0
View file @ 2ed193c9
#---------------------------------------------------------------------
# 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]
}
src/pl/tcl/pltcl.c
View file @ 817f2a58
......@@ -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
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment