r10715: More Samba3 parser generator improvements:

- Actually generate parsers for unions and structs.
- Support some more builtin types.
- Some more work on supporting arrays.
- Several other small fixes.

I've updated the example output at http://samba.org/~jelmer/

diff --git a/source/pidl/lib/Parse/Pidl/Samba3/Parser.pm b/source/pidl/lib/Parse/Pidl/Samba3/Parser.pm
index 5caab5da0c6764f917a4d57d755e5b103de5aa47..57ee1543ff6fc6adaf3fecf6b3572bb12418ff40 100644 (file)
--- a/source/pidl/lib/Parse/Pidl/Samba3/Parser.pm
+++ b/source/pidl/lib/Parse/Pidl/Samba3/Parser.pm
@@ -23,8 +23,7 @@ sub fatal($$) { my ($e,$s) = @_; die("$e->{FILE}:$e->{LINE}: $s\n"); }
 
 #TODO:
 # - Different scalars / buffers functions for arrays + unions
-# - Register own types with Types::AddType()
-# - Find external types somehow?
+# - Memory allocation for arrays?
 
 sub DeclareArrayVariables($)
 {
@@ -78,7 +77,7 @@ sub ParseElementLevelPtr($$$$$)
                fatal($e, "relative pointers not supported for Samba 3");
        }
 
-       pidl "if (!prs_uint32(\"ptr_$e->{NAME}\",ps,depth,&" . ParseExpr("ptr_$e->{NAME}", $env) . ", ps, depth))";
+       pidl "if (!prs_uint32(\"ptr_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr_$e->{NAME}", $env) . ", ps, depth))";
        pidl "\treturn False;";
        pidl "";
        
@@ -138,7 +137,7 @@ sub InitLevel($$$$)
                deindent;
                pidl "}";
        } elsif ($l->{TYPE} eq "DATA") {
-               pidl InitType($e, $l, $varname, $varname);
+               pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname);
        } elsif ($l->{TYPE} eq "SWITCH") {
                InitLevel($e, GetNextLevel($e,$l), $varname, $env);
        }
@@ -149,20 +148,22 @@ sub CreateStruct($$$$)
        my ($fn,$s,$es,$a) = @_;
 
        my $args = "";
-       foreach my $e (@$es) {
+       foreach (@$es) {
                $args .= ", " . DeclLong($_);
        }
 
-       my $env = {};
+       my $env = { "this" => "v" };
        foreach my $e (@$es) {
                foreach my $l (@{$e->{LEVELS}}) {
                        if ($l->{TYPE} eq "DATA") {
-                               $env->{"$e->{NAME}"} = $e->{"v->$e->{NAME}"};
+                               $env->{$e->{NAME}} = "v->$e->{NAME}";
                        } elsif ($l->{TYPE} eq "POINTER") {
-                               $env->{"ptr_$e->{NAME}"} = $e->{"v->ptr_$e->{NAME}"};
+                               $env->{"ptr_$e->{NAME}"} = "v->ptr_$e->{NAME}";
                        } elsif ($l->{TYPE} eq "SWITCH") {
-                               $env->{"level_$e->{NAME}"} = $e->{"v->level_$e->{NAME}"};
-                       } 
+                               $env->{"level_$e->{NAME}"} = "v->level_$e->{NAME}";
+                       } elsif ($l->{TYPE} eq "ARRAY") {
+                               $env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}";
+                       }
                }
        }
 
@@ -173,7 +174,7 @@ sub CreateStruct($$$$)
        pidl "";
        # Call init for all arguments
        foreach (@$es) {
-               InitLevel($_, $_->{LEVELS}[0], ParseExpr($_->{NAME}, $env), $env);
+               InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env);
                pidl "";
        }
        pidl "return True;";
@@ -238,11 +239,13 @@ sub ParseUnion($$$)
        foreach (@{$u->{ELEMENTS}}) {
                pidl "$_->{CASE}:";
                indent;
-               pidl "depth++;";
-               ParseElement($_, {});
+               if ($_->{TYPE} ne "EMPTY") {
+                       pidl "depth++;";
+                       ParseElement($_, {});
+                       pidl "depth--;";
+               }
+               pidl "break;";
                deindent;
-               pidl "depth--;";
-               pidl "break";
                pidl "";
        }
 
@@ -290,8 +293,8 @@ sub ParseInterface($)
        # Structures first 
        pidl "/* $if->{NAME} structures */";
        foreach (@{$if->{TYPEDEFS}}) {
-               ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "STRUCT");
-               ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{TYPE} eq "UNION");
+               ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT");
+               ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION");
        }
 
        pidl "/* $if->{NAME} functions */";

diff --git a/source/pidl/lib/Parse/Pidl/Samba3/Types.pm b/source/pidl/lib/Parse/Pidl/Samba3/Types.pm
index 68bea0d02489b59b683a70346c009d80fb8ffa36..b9d969216c04adc8600173f24f8eb29317747ba5 100644 (file)
--- a/source/pidl/lib/Parse/Pidl/Samba3/Types.pm
+++ b/source/pidl/lib/Parse/Pidl/Samba3/Types.pm
@@ -1,5 +1,5 @@
 ###################################################
-# Samba3 common helper functions
+# Samba3 type-specific declarations / initialization / marshalling
 # Copyright jelmer@samba.org 2005
 # released under the GNU GPL
 
@@ -16,6 +16,10 @@ use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred);
 use vars qw($VERSION);
 $VERSION = '0.01';
 
+# TODO: Find external types somehow?
+
+sub warning($$) { my ($e,$s) = @_; print STDERR "$e->{FILE}:$e->{LINE}: $s\n"; }
+
 sub init_scalar($$$$)
 {
        my ($e,$l,$n,$v) = @_;
@@ -36,6 +40,8 @@ sub decl_string($)
 {
        my $e = shift;
 
+       # FIXME: More intelligent code here - select between UNISTR2 and other
+       # variants
        return "UNISTR2";
 }
 
@@ -50,40 +56,67 @@ sub dissect_string($$$)
 {
        my ($e,$l,$n) = @_;
 
-       return "FIXME";
+       return "prs_unistr2(True, \"$e->{NAME}\", ps, depth, &n)";
+}
+
+sub init_uuid($$$$)
+{
+       my ($e,$l,$n,$v) = @_;
+
+       return "";
+}
+
+sub dissect_uuid($$$)
+{
+       my ($e,$l,$n) = @_;
+
+       return "smb_io_uuid(\"$e->{NAME}\", &$n, ps, depth)";
 }
 
-my $known_types = {
-       uint8 => {
+my $known_types = 
+{
+       uint8 => 
+       {
                DECL => "uint8",
                INIT => \&init_scalar,
                DISSECT => \&dissect_scalar,
        },
-       uint16 => {
+       uint16 => 
+       {
                DECL => "uint16",
                INIT => \&init_scalar,
                DISSECT => \&dissect_scalar,
        },
-       uint32 => {
+       uint32 => 
+       {
                DECL => "uint32",
                INIT => \&init_scalar,
                DISSECT => \&dissect_scalar,
        },
-       string => {
+       string => 
+       {
                DECL => \&decl_string,
                INIT => \&init_string,
                DISSECT => \&dissect_string,
        },
-       NTSTATUS => {
+       NTSTATUS => 
+       {
                DECL => "NTSTATUS",
                INIT => \&init_scalar,
                DISSECT => \&dissect_scalar,
        },
-       WERROR => {
+       WERROR => 
+       {
                DECL => "WERROR",
                INIT => \&init_scalar,
                DISSECT => \&dissect_scalar,
        },
+       GUID => 
+       {
+               DECL => "struct uuid",
+               INIT => \&init_uuid,
+               DISSECT => \&dissect_uuid,
+       }
 };
 
 sub AddType($$)
@@ -101,7 +134,10 @@ sub GetType($)
 
        my $t = $known_types->{$e->{TYPE}};
 
-       return undef if not $t;
+       if (not $t) {
+               warning($e, "Can't declare unknown type $e->{TYPE}");
+               return undef;
+       }
 
        # DECL can be a function
        if (ref($t->{DECL}) eq "CODE") {
@@ -131,7 +167,13 @@ sub DeclLong($)
 
        return undef if not $t;
 
-       return "$t $e->{NAME}";
+       my $ptrs = "";
+
+       foreach my $l (@{$e->{LEVELS}}) {
+               ($ptrs.="*") if ($l->{TYPE} eq "POINTER");
+       }
+       
+       return "$t $ptrs$e->{NAME}";
 }
 
 sub InitType($$$$)
@@ -140,7 +182,10 @@ sub InitType($$$$)
 
        my $t = $known_types->{$l->{DATA_TYPE}};
 
-       return undef if not $t;
+       if (not $t) {
+               warning($e, "Don't know how to initialize type $l->{DATA_TYPE}");
+               return undef;
+       }
 
        # INIT can be a function
        if (ref($t->{INIT}) eq "CODE") {
@@ -156,7 +201,10 @@ sub DissectType($$$)
 
        my $t = $known_types->{$l->{DATA_TYPE}};
 
-       return undef if not $t;
+       if (not $t) {
+               warning($e, "Don't know how to dissect type $l->{DATA_TYPE}");
+               return undef;
+       }
 
        # DISSECT can be a function
        if (ref($t->{DISSECT}) eq "CODE") {
@@ -166,4 +214,27 @@ sub DissectType($$$)
        }
 }
 
+sub LoadTypes($)
+{
+       my $ndr = shift;
+       foreach my $if (@{$ndr}) {
+               next unless ($if->{TYPE} eq "INTERFACE");
+
+               foreach my $td (@{$if->{TYPEDEFS}}) {
+                       AddType($td->{NAME}, {
+                               DECL => uc("$if->{NAME}_$td->{NAME}"),
+                               INIT => sub {
+                                       my ($e,$l,$n,$v) = @_;
+                                       return "init_$td->{NAME}(&$n/*FIXME:OTHER ARGS*/);";
+                               },
+                               DISSECT => sub {
+                                       my ($e,$l,$n) = @_;
+
+                                       return "$if->{NAME}_io_$td->{NAME}(\"$e->{NAME}\", &$n, ps, depth)";
+                               }
+                       });
+               }
+       }
+}
+
 1;

diff --git a/source/pidl/pidl b/source/pidl/pidl
index f0513546e90ae2c694ddd0ef1ad06efaddf90f6a..07bfefa9562c8bc1e1bf5c7d6080c69c1a3734d8 100755 (executable)
--- a/source/pidl/pidl
+++ b/source/pidl/pidl
@@ -813,6 +813,13 @@ $dcom
                print Parse::Pidl::Samba::Template::Parse($pidl);
        }
 
+       if (defined($opt_samba3_header) or defined($opt_samba3_parser) or
+               defined($opt_samba3_server) or defined($opt_samba3_client) or
+               defined($opt_samba3_template)) {
+               require Parse::Pidl::Samba3::Types;
+               Parse::Pidl::Samba3::Types::LoadTypes($ndr);
+       }
+
        if (defined($opt_samba3_header)) {
                my $header = ($opt_samba3_header or "$outputdir/rpc_$basename.h");
                require Parse::Pidl::Samba3::Header;