Thread: suspicious pointer/integer coersion

I have just noticed this code in plperl.c:
       hv_store(plperl_proc_hash, internal_proname, proname_len,                newSViv((IV) prodesc), 0);

basically, here prodesc is a pointer to a struct, and we are storing it 
as an integer in a perl hash for easy lookup by stringified oid.

How safe is this conversion on 64 bit platforms?

cheers

andrew

Andrew Dunstan <andrew@dunslane.net> writes:
> I have just noticed this code in plperl.c:

>         hv_store(plperl_proc_hash, internal_proname, proname_len,
>                  newSViv((IV) prodesc), 0);

> basically, here prodesc is a pointer to a struct, and we are storing it 
> as an integer in a perl hash for easy lookup by stringified oid.

> How safe is this conversion on 64 bit platforms?

Not at all.  I'd vote for converting the whole thing to a dynahash
hashtable ...
        regards, tom lane

Tom Lane wrote:

>Andrew Dunstan <andrew@dunslane.net> writes:
>  
>
>>I have just noticed this code in plperl.c:
>>    
>>
>
>  
>
>>        hv_store(plperl_proc_hash, internal_proname, proname_len,
>>                 newSViv((IV) prodesc), 0);
>>    
>>
>
>  
>
>>basically, here prodesc is a pointer to a struct, and we are storing it 
>>as an integer in a perl hash for easy lookup by stringified oid.
>>    
>>
>
>  
>
>>How safe is this conversion on 64 bit platforms?
>>    
>>
>
>Not at all.  I'd vote for converting the whole thing to a dynahash
>hashtable ...
>
>
>  
>

Works for me. There are some other things about the procdesc stuff I'm 
trying to sort out (especially if we should be storing per-call info 
inside it).

Cleaning this up is definitely a TODO.

cheers

andrew

Andrew Dunstan <andrew@dunslane.net> writes:
> Works for me. There are some other things about the procdesc stuff I'm 
> trying to sort out (especially if we should be storing per-call info 
> inside it).

Hmm, probably not ... check to see if a recursive plperl function
behaves sanely.  (This might not have been much of an issue before
we had SPI support in plperl, since there was no way to recurse;
but it is an issue now.)
        regards, tom lane

Tom Lane wrote:

>Andrew Dunstan <andrew@dunslane.net> writes:
>  
>
>>Works for me. There are some other things about the procdesc stuff I'm 
>>trying to sort out (especially if we should be storing per-call info 
>>inside it).
>>    
>>
>
>Hmm, probably not ... check to see if a recursive plperl function
>behaves sanely.  (This might not have been much of an issue before
>we had SPI support in plperl, since there was no way to recurse;
>but it is an issue now.)
>  
>

Behaviour is not good (see below for proof).

ISTM we'll need some sort of implicit of explicit stack of per-call 
data. The trick will be getting it to behave right under error recovery.

cheers

andrew


[andrew inst]$ bin/psql -e -f recurse.sql
create or replace function recurse(i int) returns setof text language plperl
as $$
 my $i = shift; elog(NOTICE,"i = $i"); foreach my $x (1..$i) {   return_next "hello $x"; } if ($i > 2) {   my $z =
$i-1;  my $cursor = spi_query("select * from recurse($z)");   while (defined(my $row = spi_fetchrow($cursor)))   {
return_next"recurse $i: $row";   } } return undef;
 

$$;
CREATE FUNCTION
select * from recurse(2);
psql:recurse.sql:24: NOTICE:  i = 2recurse
---------hello 1hello 2
(2 rows)

select * from recurse(3);
psql:recurse.sql:25: NOTICE:  i = 3
psql:recurse.sql:25: NOTICE:  i = 2
psql:recurse.sql:25: server closed the connection unexpectedly       This probably means the server terminated
abnormally      before or while processing the request.
 
psql:recurse.sql:25: connection to server was lost
[andrew inst]$

Andrew Dunstan wrote:

> Tom Lane wrote:
>
>> Andrew Dunstan <andrew@dunslane.net> writes:
>>
>>> Works for me. There are some other things about the procdesc stuff 
>>> I'm trying to sort out (especially if we should be storing per-call 
>>> info inside it).
>>>   
>>
>>
>> Hmm, probably not ... check to see if a recursive plperl function
>> behaves sanely.  (This might not have been much of an issue before
>> we had SPI support in plperl, since there was no way to recurse;
>> but it is an issue now.)
>
>
> Behaviour is not good (see below for proof).
>
> ISTM we'll need some sort of implicit of explicit stack of per-call 
> data. The trick will be getting it to behave right under error recovery.



Looking further ... we already do this implicitly for prodesc in the 
call handler - we would just need to do the same thing for per-call 
structures and divorce them from prodesc, which can be repeated on the 
implicit stack.

I'll work on that - changes should be quite small.

cheers

andrew

> Looking further ... we already do this implicitly for prodesc in the 
> call handler - we would just need to do the same thing for per-call 
> structures and divorce them from prodesc, which can be repeated on the 
> implicit stack.
> 
> I'll work on that - changes should be quite small.

Sounds like recursive calls are somethign that should be tested for PLs 
in the regressions...

Chris

Andrew Dunstan wrote:

>
>
>
>
> Looking further ... we already do this implicitly for prodesc in the 
> call handler - we would just need to do the same thing for per-call 
> structures and divorce them from prodesc, which can be repeated on the 
> implicit stack.
>
> I'll work on that - changes should be quite small.
>

Attached is a patch that fixes both a recently introduced problem with 
recursion and a problem with array returns that became evident as a 
result of not throwing away non-fatal warnings (thanks to David Fetter 
for noticing this). Regression test updates to include both cases are 
included in the patch.

I will start looking at putting the procedure descriptors in a dynahash.

cheers

andrew

Andrew Dunstan wrote:

>
>
> Andrew Dunstan wrote:
>
>>
>>
>>
>>
>> Looking further ... we already do this implicitly for prodesc in the
>> call handler - we would just need to do the same thing for per-call
>> structures and divorce them from prodesc, which can be repeated on
>> the implicit stack.
>>
>> I'll work on that - changes should be quite small.
>>
>
> Attached is a patch that fixes (I hope) both a recently introduced
> problem with recursion and a problem with array returns that became
> evident as a result of not throwing away non-fatal warnings (thanks to
> David Fetter for noticing this). Regression test updates to include
> both cases are included in the patch.
>
> I will start looking at putting the procedure descriptors in a dynahash.
>
>

and here's the patch this time.

cheers


andrew
Index: plperl.c
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/plperl.c,v
retrieving revision 1.84
diff -c -r1.84 plperl.c
*** plperl.c    10 Jul 2005 16:13:13 -0000    1.84
--- plperl.c    11 Jul 2005 13:08:26 -0000
***************
*** 90,98 ****
      FmgrInfo    arg_out_func[FUNC_MAX_ARGS];
      bool        arg_is_rowtype[FUNC_MAX_ARGS];
      SV           *reference;
-     FunctionCallInfo caller_info;
-     Tuplestorestate *tuple_store;
-     TupleDesc tuple_desc;
  } plperl_proc_desc;


--- 90,95 ----
***************
*** 106,113 ****

  static bool plperl_use_strict = false;

! /* this is saved and restored by plperl_call_handler */
  static plperl_proc_desc *plperl_current_prodesc = NULL;

  /**********************************************************************
   * Forward declarations
--- 103,113 ----

  static bool plperl_use_strict = false;

! /* these are saved and restored by plperl_call_handler */
  static plperl_proc_desc *plperl_current_prodesc = NULL;
+ static FunctionCallInfo plperl_current_caller_info;
+ static Tuplestorestate *plperl_current_tuple_store;
+ static TupleDesc plperl_current_tuple_desc;

  /**********************************************************************
   * Forward declarations
***************
*** 577,586 ****
--- 577,592 ----
  {
      Datum retval;
      plperl_proc_desc *save_prodesc;
+     FunctionCallInfo save_caller_info;
+     Tuplestorestate *save_tuple_store;
+     TupleDesc save_tuple_desc;

      plperl_init_all();

      save_prodesc = plperl_current_prodesc;
+     save_caller_info = plperl_current_caller_info;
+     save_tuple_store = plperl_current_tuple_store;
+     save_tuple_desc = plperl_current_tuple_desc;

      PG_TRY();
      {
***************
*** 592,602 ****
--- 598,614 ----
      PG_CATCH();
      {
          plperl_current_prodesc = save_prodesc;
+         plperl_current_caller_info = save_caller_info;
+         plperl_current_tuple_store = save_tuple_store;
+         plperl_current_tuple_desc = save_tuple_desc;
          PG_RE_THROW();
      }
      PG_END_TRY();

      plperl_current_prodesc = save_prodesc;
+     plperl_current_caller_info = save_caller_info;
+     plperl_current_tuple_store = save_tuple_store;
+     plperl_current_tuple_desc = save_tuple_desc;

      return retval;
  }
***************
*** 897,902 ****
--- 909,915 ----
      SV           *perlret;
      Datum        retval;
      ReturnSetInfo *rsi;
+         SV* array_ret = NULL;

      if (SPI_connect() != SPI_OK_CONNECT)
          elog(ERROR, "could not connect to SPI manager");
***************
*** 904,912 ****
      prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);

      plperl_current_prodesc = prodesc;
!     prodesc->caller_info = fcinfo;
!     prodesc->tuple_store = 0;
!     prodesc->tuple_desc = 0;

      perlret = plperl_call_perl_func(prodesc, fcinfo);

--- 917,925 ----
      prodesc = compile_plperl_function(fcinfo->flinfo->fn_oid, false);

      plperl_current_prodesc = prodesc;
!     plperl_current_caller_info = fcinfo;
!     plperl_current_tuple_store = 0;
!     plperl_current_tuple_desc = 0;

      perlret = plperl_call_perl_func(prodesc, fcinfo);

***************
*** 958,967 ****
          }

          rsi->returnMode = SFRM_Materialize;
!         if (prodesc->tuple_store)
          {
!             rsi->setResult = prodesc->tuple_store;
!             rsi->setDesc = prodesc->tuple_desc;
          }
          retval = (Datum)0;
      }
--- 971,980 ----
          }

          rsi->returnMode = SFRM_Materialize;
!         if (plperl_current_tuple_store)
          {
!             rsi->setResult = plperl_current_tuple_store;
!             rsi->setDesc = plperl_current_tuple_desc;
          }
          retval = (Datum)0;
      }
***************
*** 1006,1012 ****
      {
          /* Return a perl string converted to a Datum */
          char *val;
-         SV* array_ret;


          if (prodesc->fn_retisarray && SvTYPE(SvRV(perlret)) == SVt_PVAV)
--- 1019,1024 ----
***************
*** 1024,1030 ****
                                 Int32GetDatum(-1));
      }

!     SvREFCNT_dec(perlret);
      return retval;
  }

--- 1036,1044 ----
                                 Int32GetDatum(-1));
      }

!     if (array_ret == NULL)
!       SvREFCNT_dec(perlret);
!
      return retval;
  }

***************
*** 1526,1532 ****
  plperl_return_next(SV *sv)
  {
      plperl_proc_desc *prodesc = plperl_current_prodesc;
!     FunctionCallInfo fcinfo = prodesc->caller_info;
      ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo;
      MemoryContext cxt;
      HeapTuple tuple;
--- 1540,1546 ----
  plperl_return_next(SV *sv)
  {
      plperl_proc_desc *prodesc = plperl_current_prodesc;
!     FunctionCallInfo fcinfo = plperl_current_caller_info;
      ReturnSetInfo *rsi = (ReturnSetInfo *)fcinfo->resultinfo;
      MemoryContext cxt;
      HeapTuple tuple;
***************
*** 1553,1560 ****

      cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);

!     if (!prodesc->tuple_store)
!         prodesc->tuple_store = tuplestore_begin_heap(true, false, work_mem);

      if (prodesc->fn_retistuple)
      {
--- 1567,1575 ----

      cxt = MemoryContextSwitchTo(rsi->econtext->ecxt_per_query_memory);

!     if (!plperl_current_tuple_store)
!         plperl_current_tuple_store =
!             tuplestore_begin_heap(true, false, work_mem);

      if (prodesc->fn_retistuple)
      {
***************
*** 1590,1599 ****
          tuple = heap_form_tuple(tupdesc, &ret, &isNull);
      }

!     if (!prodesc->tuple_desc)
!         prodesc->tuple_desc = tupdesc;

!     tuplestore_puttuple(prodesc->tuple_store, tuple);
      heap_freetuple(tuple);
      MemoryContextSwitchTo(cxt);
  }
--- 1605,1614 ----
          tuple = heap_form_tuple(tupdesc, &ret, &isNull);
      }

!     if (!plperl_current_tuple_desc)
!         plperl_current_tuple_desc = tupdesc;

!     tuplestore_puttuple(plperl_current_tuple_store, tuple);
      heap_freetuple(tuple);
      MemoryContextSwitchTo(cxt);
  }
Index: expected/plperl.out
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/expected/plperl.out,v
retrieving revision 1.3
diff -c -r1.3 plperl.out
*** expected/plperl.out    10 Jul 2005 15:19:43 -0000    1.3
--- expected/plperl.out    11 Jul 2005 13:08:26 -0000
***************
*** 367,369 ****
--- 367,422 ----
               2
  (2 rows)

+ ---
+ --- Test recursion via SPI
+ ---
+ CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl
+ AS $$
+
+   my $i = shift;
+   foreach my $x (1..$i)
+   {
+     return_next "hello $x";
+   }
+   if ($i > 2)
+   {
+     my $z = $i-1;
+     my $cursor = spi_query("select * from recurse($z)");
+     while (defined(my $row = spi_fetchrow($cursor)))
+     {
+       return_next "recurse $i: $row->{recurse}";
+     }
+   }
+   return undef;
+
+ $$;
+ SELECT * FROM recurse(2);
+  recurse
+ ---------
+  hello 1
+  hello 2
+ (2 rows)
+
+ SELECT * FROM recurse(3);
+       recurse
+ --------------------
+  hello 1
+  hello 2
+  hello 3
+  recurse 3: hello 1
+  recurse 3: hello 2
+ (5 rows)
+
+ ---
+ --- Test arrary return
+ ---
+ CREATE OR REPLACE FUNCTION  array_of_text() RETURNS TEXT[][]
+ LANGUAGE plperl as $$
+     return [['a"b','c,d'],['e\\f','g']];
+ $$;
+ SELECT array_of_text();
+         array_of_text
+ -----------------------------
+  {{"a\"b","c,d"},{"e\\f",g}}
+ (1 row)
+
Index: sql/plperl.sql
===================================================================
RCS file: /projects/cvsroot/pgsql/src/pl/plperl/sql/plperl.sql,v
retrieving revision 1.3
diff -c -r1.3 plperl.sql
*** sql/plperl.sql    10 Jul 2005 15:19:43 -0000    1.3
--- sql/plperl.sql    11 Jul 2005 13:08:26 -0000
***************
*** 260,262 ****
--- 260,303 ----
  return;
  $$ LANGUAGE plperl;
  SELECT * from perl_spi_func();
+
+
+ ---
+ --- Test recursion via SPI
+ ---
+
+
+ CREATE OR REPLACE FUNCTION recurse(i int) RETURNS SETOF TEXT LANGUAGE plperl
+ AS $$
+
+   my $i = shift;
+   foreach my $x (1..$i)
+   {
+     return_next "hello $x";
+   }
+   if ($i > 2)
+   {
+     my $z = $i-1;
+     my $cursor = spi_query("select * from recurse($z)");
+     while (defined(my $row = spi_fetchrow($cursor)))
+     {
+       return_next "recurse $i: $row->{recurse}";
+     }
+   }
+   return undef;
+
+ $$;
+
+ SELECT * FROM recurse(2);
+ SELECT * FROM recurse(3);
+
+
+ ---
+ --- Test arrary return
+ ---
+ CREATE OR REPLACE FUNCTION  array_of_text() RETURNS TEXT[][]
+ LANGUAGE plperl as $$
+     return [['a"b','c,d'],['e\\f','g']];
+ $$;
+
+ SELECT array_of_text();

Andrew Dunstan <andrew@dunslane.net> writes:
>> Attached is a patch that fixes (I hope) both a recently introduced 
>> problem with recursion and a problem with array returns that became 
>> evident as a result of not throwing away non-fatal warnings (thanks to 
>> David Fetter for noticing this). Regression test updates to include 
>> both cases are included in the patch.

Applied, thanks.
        regards, tom lane

This seems to have gone AWOL in the email ether, so I am resending.

-------- Original Message --------

Tom Lane wrote:

>Andrew Dunstan <andrew@dunslane.net> writes:
>  
>
>>I have just noticed this code in plperl.c:
>>    
>>
>>        hv_store(plperl_proc_hash, internal_proname, proname_len,
>>                 newSViv((IV) prodesc), 0);
>>    
>>
>>basically, here prodesc is a pointer to a struct, and we are storing it 
>>as an integer in a perl hash for easy lookup by stringified oid.
>>
>>How safe is this conversion on 64 bit platforms?
>>    
>>
>
>Not at all.  I'd vote for converting the whole thing to a dynahash
>hashtable ...
>
>  
>


Further investigation yields this from the perlguts man page:
     What is an "IV"?
     Perl uses a special typedef IV which is a simple signed integer type     that is guaranteed to be large enough to
holda pointer (as well as      an integer).
 

So it looks like my original concern was unfounded. Sorry for the noise. 
We now return you to your previous program ...

cheers

andrew