Commit 05fd826e authored by Marc Lehmann's avatar Marc Lehmann

see plug-ins/perl/Changes

parent edda8d6b
Revision history for Gimp-Perl extension.
1.09
1.09 Fri May 21 14:12:02 CEST 1999
- added gimpdoc, a simple man-like help viewer.
- corrected PDL version check to work with version 2.001.
- new file Net.xs, containing protocol serializer
- new file Net.xs, containing protocol serializer.
- new, faster and leaner protocol (bumped protocol version number).
- added SvPV_nolen to ppport.h and made use of it everywhere.
- renamed nolib => Module.
- streamlined warning messages as not to scare the people away.
- fixed a bug in check_for_typoe (correct TRUE and FALSE).
- zero-copy piddle support should generally work now. Tile
functions and network support is still missing, but...
- experimental enhancements to the spawn/ hosttype.
- Gimp::Feature no longer counts dos as unix-like.
1.089 Tue May 18 19:55:25 CEST 1999
- added colourtoalpha.
......@@ -21,7 +26,7 @@ Revision history for Gimp-Perl extension.
- re-added PARASITE_*-constants (including UNDOABLE variants).
- temporarily disabled the module for political reasons.
- made my first attempt at implementing XS-PDL support.
- transform obnjects ids of -1 into undef and vice versa.
- transform objects ids of -1 into undef and vice versa.
- Gimp::Fu did not properly supply a default value for PF_COLOUR.
1.083 Wed May 12 03:36:10 CEST 1999
......
......@@ -5,7 +5,7 @@ use Carp;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK $AUTOLOAD %EXPORT_TAGS @EXPORT_FAIL
@_consts @_procs $interface_pkg $interface_type @_param @_al_consts
@PREFIXES $_PROT_VERSION
@gimp_gui_functions $function $basename
@gimp_gui_functions $function $basename $spawn_opts
$in_quit $in_run $in_net $in_init $in_query $no_SIG
$help $verbose $host);
use subs qw(init end lock unlock canonicalize_color);
......@@ -120,6 +120,8 @@ sub import($;@) {
push(@export,@_param);
} elsif (/^interface=(\S+)$/) {
croak "interface=... tag is no longer supported\n";
} elsif ($_=~/spawn_options=(\S+)/) {
$spawn_opts = $1;
} elsif ($_ ne "") {
push(@export,$_);
} elsif ($_ eq "") {
......@@ -202,6 +204,8 @@ sub canonicalize_colour {
($basename = $0) =~ s/^.*[\\\/]//;
$spawn_opts = "";
# extra check for Gimp::Feature::import
$in_query=0 unless defined $in_query; # perl -w is SOOO braindamaged
$in_quit=$in_run=$in_net=$in_init=0; # perl -w is braindamaged
......@@ -575,6 +579,10 @@ Import PARAM_* constants (PARAM_INT32, PARAM_STRING etc.) only.
All constants from gimpenums.h (BG_IMAGE_FILL, RUN_NONINTERACTIVE, NORMAL_MODE, PARAM_INT32 etc.).
=item spawn_options=I<options>
Set default spawn options to I<options>, see L<Gimp::Net>.
=back
The default (unless '' is specified) is C<main xlfd_size :consts>.
......
......@@ -85,6 +85,7 @@ sub present {
MacOS => 1,
MSWin32 => 1,
os2 => 1,
dos => 1,
VMS => 1,
}->{$^O};
} elsif ($_ eq "never") {
......
......@@ -135,7 +135,9 @@ sub set_trace {
}
sub start_server {
print "trying to start gimp\n" if $Gimp::verbose;
my $opt = shift;
$opt = $Gimp::spawn_opts unless $opt;
print "trying to start gimp with options \"$opt\"\n" if $Gimp::verbose;
$server_fh=local *FH;
my $gimp_fh=local *FH;
socketpair $server_fh,$gimp_fh,PF_UNIX,SOCK_STREAM,AF_UNIX
......@@ -159,8 +161,15 @@ sub start_server {
fileno($gimp_fh);
{ # block to suppress warning with broken perls (e.g. 5.004)
require Gimp::Config;
my @args;
push(@args,"--no-data") if $opt=~s/(^|:)no-?data//;
push(@args,"-n") unless $opt=~s/(^|:)gui//;
push(@args,"--verbose") if $Gimp::verbose;
exec $Gimp::Config{GIMP_PATH},
"-n","-b","(extension-perl-server $args)",
"--no-splash",
@args,
"-b",
"(extension-perl-server $args)",
"(extension_perl_server $args)",
"(gimp_quit 0)",
"(gimp-quit 0)";
......@@ -177,7 +186,7 @@ sub try_connect {
$auth = s/^(.*)\@// ? $1 : ""; # get authorization
if ($_ ne "") {
if (s{^spawn/}{}) {
return start_server;
return start_server($_);
} elsif (s{^unix/}{/}) {
my $server_fh=local *FH;
return socket($server_fh,PF_UNIX,SOCK_STREAM,AF_UNIX)
......@@ -295,13 +304,15 @@ then it is probably installed.
The Perl-Server can either be started from the C<<Xtns>> menu in Gimp, or automatically
when a perl script can't find a running Perl-Server.
When started from within The Gimp, the Perl-Server will create a unix domain
socket to which local clients can connect. If an authorization password is
given to the Perl-Server (by defining the environment variable C<GIMP_HOST>
before starting The Gimp), it will also listen on a tcp port (default
10009). Since the password is transmitted in cleartext, using the Perl-Server
over tcp effectively B<lowers the security of your network to the level of
telnet>.
When started from within The Gimp, the Perl-Server will create a unix
domain socket to which local clients can connect. If an authorization
password is given to the Perl-Server (by defining the environment variable
C<GIMP_HOST> before starting The Gimp), it will also listen on a tcp port
(default 10009). Since the password is transmitted in cleartext, using the
Perl-Server over tcp effectively B<lowers the security of your network to
the level of telnet>. Even worse: the current Gimp::Net-protocol can be
used for denial of service attacks, i.e. crashing the Perl-Server. There
also *might* be buffer-overflows (although I do care a lot for these).
=head1 ENVIRONMENT
......@@ -321,6 +332,8 @@ and spawn/ for a private gimp instance. Examples are:
authorize@ # specify authorization only
spawn/ # use a private gimp instance
spawn/nodata # pass --no-data switch
spawn/gui # don't pass -n switch
=head1 CALLBACKS
......
......@@ -13,6 +13,7 @@ Gimp.pm
Gimp.xs
scm2perl
scm2scm
gimpdoc
t/load.t
t/loadlib.t
t/run.t
......
......@@ -283,7 +283,7 @@ WriteMakefile(
'LIBS' => [''],
'INC' => "$INC1 $GIMP_INC_NOUI $CPPFLAGS $CFLAGS",
'DEFINE' => "$DEFINE1 $DEFS",
'EXE_FILES' => ['scm2perl','scm2scm'],
'EXE_FILES' => ['scm2perl','scm2scm','gimpdoc'],
'macro' => \%cfg,
'realclean' => { FILES => "config.status config.cache config.log config.pl config.h Gimp/Config.pm" },
'clean' => { FILES => "Makefile.old stamp-h" },
......
......@@ -37,18 +37,35 @@ static void need_pdl (void)
#endif
#define is_dynamic(sv) \
(sv_derived_from (sv, "Gimp::Tile") \
|| sv_derived_from (sv, "Gimp::PixelRgn") \
|| sv_derived_from (sv, "Gimp::GDrawable"))
#define is_dynamic(sv) \
(strEQ ((sv), "Gimp::Tile") \
|| strEQ ((sv), "Gimp::PixelRgn") \
|| strEQ ((sv), "Gimp::GDrawable"))
static GHashTable *object_cache;
static gint object_id = 1000;
#define init_object_cache if (!object_cache) object_cache = g_hash_table_new (g_int_hash, g_int_equal)
static void destroy (gint id)
static void destroy_object (SV *sv)
{
init_object_cache;
if (object_cache && sv_isobject (sv))
{
if (is_dynamic (HvNAME(SvSTASH(SvRV(sv)))))
{
gint id = SvIV(SvRV(sv));
SV *cv = (SV*)g_hash_table_lookup (object_cache, &id);
if (cv)
{
SvREFCNT_dec (cv);
g_hash_table_remove (object_cache, &id);
}
}
else
croak ("Internal error: Gimp::Net #101, please report!");
}
else
croak ("Internal error: Gimp::Net #100, please report!");
}
/* allocate this much as initial length */
......@@ -83,9 +100,15 @@ static void sv2net (int deobjectify, SV *s, SV *sv)
sv_catpvf (s, "b%x:%s", strlen (name), name);
if (is_dynamic (sv))
if (deobjectify && is_dynamic (name))
{
//return;
object_id++;
SvREFCNT_inc(sv);
g_hash_table_insert (object_cache, &object_id, (gpointer)sv);
sv_catpvf (s, "i%d:", object_id);
return; /* well... */
}
}
else
......@@ -96,7 +119,7 @@ static void sv2net (int deobjectify, SV *s, SV *sv)
AV *av = (AV*)rv;
int i;
sv_catpvf (s, "a%x:", (int)av_len(av));
sv_catpvf (s, "a%x:", (I32)av_len(av));
for (i = 0; i <= av_len(av); i++)
sv2net (deobjectify, s, *av_fetch(av,i,0));
}
......@@ -130,6 +153,7 @@ static SV *net2sv (int objectify, char **_s)
SV *sv;
AV *av;
unsigned int ui, n;
I32 i32,i33;
long l;
char str[64];
......@@ -161,15 +185,30 @@ static SV *net2sv (int objectify, char **_s)
memcpy (str, s, ui); s += ui;
str[ui] = 0;
sv = sv_bless (newRV_noinc (net2sv (objectify, &s)), gv_stashpv (str, 1));
if (objectify && is_dynamic (str))
{
gint id;
sscanf (s, "i%ld:%n", &l, &n); s += n;
sv = (SV*)g_hash_table_lookup (object_cache, (id=l,&id));
if (!sv)
croak ("Internal error: asked to deobjectify an object not in the cache, please report!");
}
else
sv = net2sv (objectify, &s);
sv = sv_bless (newRV_noinc (sv), gv_stashpv (str, 1));
break;
case 'a':
sscanf (s, "%x:%n", &ui, &n); s += n;
sscanf (s, "%x:%n", &i32, &n); s += n;
av = newAV ();
av_extend (av, ui);
for (n = 0; n <= ui; n++)
av_store (av, n, net2sv (objectify, &s));
av_extend (av, i32);
for (i33 = 0; i33 <= i32; i33++)
av_store (av, i33, net2sv (objectify, &s));
sv = (SV*)av;
break;
......@@ -201,7 +240,7 @@ args2net(deobjectify,...)
for (index = 1; index < items; index++)
sv2net (deobjectify, RETVAL, ST(index));
/*printf (">>>>%s\n",SvPV_nolen(RETVAL));*/
/*printf (">>>>%s\n",SvPV_nolen(RETVAL));*//*D*/
OUTPUT:
RETVAL
......@@ -211,10 +250,18 @@ net2args(objectify,s)
char * s
PPCODE:
/*printf ("<<<<%s\n",s);*/
/*printf ("<<<<%s\n",s);*//*D*/
if (objectify) init_object_cache;
/* this depends on a trailing zero! */
while (*s)
XPUSHs (sv_2mortal (net2sv (objectify, &s)));
void
destroy_objects(...)
CODE:
int index;
for (index = 0; index < items; index++)
destroy_object (ST(index));
......@@ -13,8 +13,7 @@ use Socket;
use strict;
use vars qw($use_unix $use_tcp $trace_res $server_quit $max_pkt $unix $tcp $ps_flags
%object_dynamic $object_uid %objects $auth @authorized $exclusive
$rm $saved_rm);
$auth @authorized $exclusive $rm $saved_rm %stats);
# the '' might be required (i.e. no ()). why??
use Gimp ();
use Gimp::Net ();
......@@ -56,47 +55,15 @@ sub slog {
print time(),": ",@_,"\n";
}
# which objects are dynamic and mustn't be destroyed at will
%object_dynamic = (
'Gimp::Tile' => 1,
'Gimp::PixelRgn' => 1,
'Gimp::GDrawable' => 1,
);
$object_uid=0;
# convert objects to, well... networkable objects
sub deobjectify {
my(@args)=@_;
for(@args) {
if($object_dynamic{ref $_}) {
$objects{++$object_uid}=$_;
$_=bless \(my $x=$object_uid),ref $_;
}
}
@args;
}
# make real objects again
sub objectify {
my(@args)=@_;
for(@args) {
if($object_dynamic{ref $_}) {
$_=$objects{$$_};
}
}
@args;
}
sub destroy_objects {
delete @objects{map $$_,@_};
Gimp::Net::destroy_objects(@_);
}
# this is hardcoded into handle_request!
sub reply {
my $fh=shift;
my $data=Gimp::Net::args2net(0,@_);
print $fh pack("N",length($data)).$data;
my $fh=shift;
my $data=Gimp::Net::args2net(0,@_);
print $fh pack("N",length($data)).$data;
}
sub handle_request($) {
......@@ -121,20 +88,20 @@ sub handle_request($) {
if($req eq "EXEC") {
no strict 'refs';
($req,@args)=Gimp::Net::net2args(1,$data);
@args=deobjectify(eval { Gimp->$req(objectify(@args)) });
@args=eval { Gimp->$req(@args) };
$data=Gimp::Net::args2net(1,$@,@args);
print $fh pack("N",length($data)).$data;
} elsif ($req eq "TEST") {
no strict 'refs';
print $fh (defined(*{"Gimp::Lib::$data"}{CODE}) || Gimp::_gimp_procedure_available($data)) ? "1" : "0";
} elsif ($req eq "DTRY") {
destroy_objects Gimp::Net::net2args(0,$data);
Gimp::Net::destroy_objects Gimp::Net::net2args 0,$data;
} elsif($req eq "TRCE") {
no strict 'refs';
($trace_level,$req,@args)=Gimp::Net::net2args(1,$data);
($trace_level,$req,@args)=Gimp::Net::net2args 1,$data;
Gimp::set_trace($trace_level);
$trace_res="";
@args=deobjectify(eval { Gimp->$req(objectify(@args)) });
@args=eval { Gimp->$req(@args) };
$data=Gimp::Net::args2net(1,$trace_res,$@,@args);
print $fh pack("N",length($data)).$data;
Gimp::set_trace(0);
......@@ -283,6 +250,7 @@ sub extension_perl_server {
push(@r,"AUTH") if $auth;
reply $fh,@r;
vec($rm,fileno($fh),1)=1;
$stats{fileno($fh)}=[0,time];
}
while(!$server_quit) {
......@@ -302,8 +270,10 @@ sub extension_perl_server {
for $f (keys(%handles)) {
if(vec($r,$f,1)) {
$fh=$handles{$f};
unless(handle_request($fh)) {
slog "closing connection ",$f;
if(handle_request($fh)) {
$stats{$f}[0]++;
} else {
slog "closing connection ",$f," ($stats{$f}[0] requests in ",time-$stats{$f}[1]," seconds)";
if ($exclusive) {
$rm = $saved_rm;
$exclusive = 0;
......
......@@ -10,6 +10,7 @@ make test TEST_VERBOSE=1
bugs
* don't start gimp in cmdline mode and error.
* KILL :auto from default(!)
* auto-flush of gdrawable when merge_shadow(?)
* gimp-piddle must be written back automatically on destroy, if changed
......@@ -30,8 +31,9 @@ bugs
important issues
* gimp_progress_done
* pdb_proc_renameto
* gimp_progress_init (1 & 2 args)
[DONE] * gimp_progress_init (1 & 2 args)
* gimp_default_display (...) for libgimp
* Gimp::Module for modules (!)
* gimp_progress_close
......@@ -49,18 +51,16 @@ important issues
* --ui and --noui for Gimp::Fu
* Gimp::ping
* allow plug-ins to register with only a drawable argument(!)
(fix this in Gimp)
* gradient button
* implement Perl-Server RSET and shared lock(!)
* use Gimp qw(GIMP_HOST=jfjf)???
[DONE] * zero-copy PDL support
* weighted movement in drawing tools
* -DMIN_PERL_DEFINE
[KILL] * -DMIN_PERL_DEFINE
* --function localfunc to select one of the registered scripts
* brush etc. buttons (maybe use gimp's interface, but
only when local(?))
[DONE] * brush etc. buttons (maybe use gimp's interface, but only when local(?))
* create working progress when Net and $verbose
* require Storable soon(!)
[KILL] * require Storable soon(!)
* Gimp::Fu::command(?)
* default parameters at end(!)
* try to deduce default parameters
......
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