diff options
Diffstat (limited to 'source4/pidl/lib/Parse/Pidl/Samba3')
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba3/Header.pm | 223 | ||||
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm | 603 | ||||
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba3/Template.pm | 82 | ||||
-rw-r--r-- | source4/pidl/lib/Parse/Pidl/Samba3/Types.pm | 403 |
4 files changed, 0 insertions, 1311 deletions
diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm deleted file mode 100644 index c479b14afa..0000000000 --- a/source4/pidl/lib/Parse/Pidl/Samba3/Header.pm +++ /dev/null @@ -1,223 +0,0 @@ -################################################### -# Samba3 NDR header generator for IDL structures -# Copyright jelmer@samba.org 2005 -# released under the GNU GPL - -package Parse::Pidl::Samba3::Header; - -use strict; -use Parse::Pidl::Typelist qw(hasType getType); -use Parse::Pidl::Util qw(has_property ParseExpr); -use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred); -use Parse::Pidl::Samba3::Types qw(DeclShort StringType); - -use vars qw($VERSION); -$VERSION = '0.01'; - -my $res = ""; -my $tabs = ""; -sub indent() { $tabs.="\t"; } -sub deindent() { $tabs = substr($tabs, 1); } -sub pidl($) { $res .= $tabs.(shift)."\n"; } -sub fatal($$) { my ($e,$s) = @_; die("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); } -sub warning($$) { my ($e,$s) = @_; warn("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); } - -sub ParseElement($) -{ - my $e = shift; - - foreach my $l (@{$e->{LEVELS}}) { - if ($l->{TYPE} eq "POINTER") { - next if ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP"); - pidl "\tuint32 ptr$l->{POINTER_INDEX}_$e->{NAME};"; - } elsif ($l->{TYPE} eq "SWITCH") { - } elsif ($l->{TYPE} eq "DATA") { - my $n = DeclShort($e); - pidl "\t$n;" if ($n); - } elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_ZERO_TERMINATED}) { - my ($t,$f) = StringType($e,$l); - pidl "\t" . uc($t) . " $e->{NAME};"; - return; - } elsif ($l->{TYPE} eq "ARRAY") { - if ($l->{IS_CONFORMANT}) { - pidl "\tuint32 size_$e->{NAME};"; - } - if ($l->{IS_VARYING}) { - pidl "\tuint32 length_$e->{NAME};"; - pidl "\tuint32 offset_$e->{NAME};"; - } - } - } -} - -sub CreateStruct($$$$) -{ - my ($if,$fn,$n,$t) = @_; - - pidl "typedef struct $n {"; - ParseElement($_) foreach (@$t); - - if (not @$t) { - # Some compilers don't like empty structs - pidl "\tuint32 dummy;"; - } - - pidl "} " . uc($n) . ";"; - pidl ""; -} - -sub ParseFunction($$) -{ - my ($if,$fn) = @_; - - my @in = (); - my @out = (); - - foreach (@{$fn->{ELEMENTS}}) { - push (@in, $_) if (grep(/in/, @{$_->{DIRECTION}})); - push (@out, $_) if (grep(/out/, @{$_->{DIRECTION}})); - } - - if (defined($fn->{RETURN_TYPE})) { - push (@out, { - NAME => "status", - TYPE => $fn->{RETURN_TYPE}, - LEVELS => [ - { - TYPE => "DATA", - DATA_TYPE => $fn->{RETURN_TYPE} - } - ] - } ); - } - - # define Q + R structures for functions - - CreateStruct($if, $fn, "$if->{NAME}_q_$fn->{NAME}", \@in); - CreateStruct($if, $fn, "$if->{NAME}_r_$fn->{NAME}", \@out); -} - -sub ParseStruct($$$) -{ - my ($if,$s,$n) = @_; - - CreateStruct($if, $s, "$if->{NAME}_$n", $s->{ELEMENTS}); -} - -sub ParseUnion($$$) -{ - my ($if,$u,$n) = @_; - - my $extra = { - switch_value => $u->{SWITCH_TYPE} - }; - - if (not defined($extra->{switch_value})) { - $extra->{switch_value} = "uint32"; - } - - foreach my $e (@{$u->{ELEMENTS}}) { - foreach my $l (@{$e->{LEVELS}}) { - if ($l->{TYPE} eq "ARRAY") { - if ($l->{IS_CONFORMANT}) { - $extra->{"size"} = "uint32"; - } - if ($l->{IS_VARYING}) { - $extra->{"length"} = $extra->{"offset"} = "uint32"; - } - } elsif ($l->{TYPE} eq "POINTER") { - $extra->{"ptr$l->{POINTER_INDEX}"} = "uint32"; - } elsif ($l->{TYPE} eq "SWITCH") { - $extra->{"level"} = "uint32"; - } - } - } - - pidl "typedef struct $if->{NAME}_$n\_ctr {"; - indent; - pidl "$extra->{$_} $_;" foreach (keys %$extra); - pidl "union $if->{NAME}_$n {"; - indent; - foreach (@{$u->{ELEMENTS}}) { - next if ($_->{TYPE} eq "EMPTY"); - pidl "\t" . DeclShort($_) . ";"; - } - deindent; - pidl "} u;"; - deindent; - pidl "} ".uc("$if->{NAME}_$n\_ctr") .";"; - pidl ""; -} - -sub ParseEnum($$$) -{ - my ($if,$s,$n) = @_; - - pidl "typedef enum {"; - pidl "$_," foreach (@{$s->{ELEMENTS}}); - pidl "} $n;"; -} - -sub ParseBitmap($$$) -{ - my ($if,$s,$n) = @_; - - pidl "#define $_" foreach (@{$s->{ELEMENTS}}); -} - -sub ParseInterface($) -{ - my $if = shift; - - my $def = "_RPC_" . uc($if->{NAME}) . "_H"; - - pidl ""; - - pidl "\#ifndef $def"; - pidl "\#define $def"; - - pidl ""; - - foreach (@{$if->{FUNCTIONS}}) { - pidl "\#define " . uc($_->{NAME}) . " $_->{OPNUM}" ; - } - - pidl ""; - - foreach (@{$if->{TYPES}}) { - ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT"); - ParseEnum($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "ENUM"); - ParseBitmap($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "BITMAP"); - ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION"); - } - - ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}}); - - foreach (@{$if->{CONSTS}}) { - pidl "$_->{NAME} ($_->{VALUE})"; - } - - pidl "\#endif /* $def */"; -} - -sub Parse($$) -{ - my($ndr,$filename) = @_; - - $res = ""; - $tabs = ""; - - pidl "/*"; - pidl " * Unix SMB/CIFS implementation."; - pidl " * header auto-generated by pidl. DO NOT MODIFY!"; - pidl " */"; - pidl ""; - - # Loop over interfaces - foreach (@{$ndr}) { - ParseInterface($_) if ($_->{TYPE} eq "INTERFACE"); - } - return $res; -} - -1; diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm deleted file mode 100644 index 57fa3867f7..0000000000 --- a/source4/pidl/lib/Parse/Pidl/Samba3/Parser.pm +++ /dev/null @@ -1,603 +0,0 @@ -################################################### -# Samba3 NDR parser generator for IDL structures -# Copyright jelmer@samba.org 2005 -# released under the GNU GPL - -package Parse::Pidl::Samba3::Parser; - -use strict; -use Parse::Pidl::Typelist qw(hasType getType mapType); -use Parse::Pidl::Util qw(has_property ParseExpr); -use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred); -use Parse::Pidl::Samba3::Types qw(DeclShort DeclLong InitType DissectType StringType); - -use vars qw($VERSION); -$VERSION = '0.01'; - -use constant PRIMITIVES => 1; -use constant DEFERRED => 2; - -my $res = ""; -my $tabs = ""; -sub indent() { $tabs.="\t"; } -sub deindent() { $tabs = substr($tabs, 1); } -sub pidl($) { $res .= $tabs.(shift)."\n"; } -sub fatal($$) { my ($e,$s) = @_; die("$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"); } - -#TODO: -# - Add some security checks (array sizes, memory alloc == NULL, etc) -# - Don't add seperate _p and _d functions if there is no deferred data -# - [string] with non-varying arrays and "surrounding" strings -# - subcontext() -# - DATA_BLOB - -sub Align($$) -{ - my ($a,$b) = @_; - - # Only align if previous element was smaller than current one - if ($$a < $b) { - pidl "if (!prs_align_custom(ps, $b))"; - pidl "\treturn False;"; - pidl ""; - } - - $$a = $b; -} - -sub DeclareArrayVariables -{ - my $es = shift; - my $what = shift; - - my $output = 0; - - foreach my $e (@$es) { - foreach my $l (@{$e->{LEVELS}}) { - if ($what) { - next if ($l->{IS_DEFERRED} and $what == PRIMITIVES); - next if (not $l->{IS_DEFERRED} and $what == DEFERRED); - } - if ($l->{TYPE} eq "ARRAY" and not $l->{IS_ZERO_TERMINATED}) { - pidl "uint32 i_$e->{NAME}_$l->{LEVEL_INDEX};"; - $output = 1; - } - } - } - pidl "" if $output; -} - -sub ParseElementLevelData($$$$$$$) -{ - my ($e,$l,$nl,$env,$varname,$what,$align) = @_; - - my $c = DissectType($e,$l,$varname,$what,$align); - return if not $c; - - if (defined($e->{ALIGN})) { - Align($align, $e->{ALIGN}); - } else { - # Default to 4 - Align($align, 4); - } - - pidl "if (!$c)"; - pidl "\treturn False;"; -} - -sub ParseElementLevelArray($$$$$$$) -{ - my ($e,$l,$nl,$env,$varname,$what,$align) = @_; - - if ($l->{IS_ZERO_TERMINATED}) { - return if ($what == DEFERRED); - - my ($t,$f) = StringType($e,$l); - - Align($align, 4); - pidl "if (!smb_io_$t(\"$e->{NAME}\", &$varname, 1, ps, depth))"; - pidl "\treturn False;"; - - $$align = 0; - return; - } - - my $len = ParseExpr($l->{LENGTH_IS}, $env); - my $size = ParseExpr($l->{SIZE_IS}, $env); - - if ($what == PRIMITIVES) { - # Fetch headers - if ($l->{IS_CONFORMANT} and not $l->{IS_SURROUNDING}) { - Align($align, 4); - pidl "if (!prs_uint32(\"size_$e->{NAME}\", ps, depth, &" . ParseExpr("size_$e->{NAME}", $env) . "))"; - pidl "\treturn False;"; - pidl ""; - } - - if ($l->{IS_VARYING}) { - Align($align, 4); - pidl "if (!prs_uint32(\"offset_$e->{NAME}\", ps, depth, &" . ParseExpr("offset_$e->{NAME}", $env) . "))"; - pidl "\treturn False;"; - pidl ""; - - pidl "if (!prs_uint32(\"length_$e->{NAME}\", ps, depth, &" . ParseExpr("length_$e->{NAME}", $env) . "))"; - pidl "\treturn False;"; - pidl ""; - } - } - - # Everything but fixed arrays have to be allocated - if (!$l->{IS_FIXED} and $what == PRIMITIVES) { - pidl "if (UNMARSHALLING(ps)) {"; - indent; - pidl "$varname = (void *)PRS_ALLOC_MEM_VOID(ps,sizeof(*$varname)*$size);"; - deindent; - pidl "}"; - } - - return if ($what == DEFERRED and not ContainsDeferred($e,$l)); - - my $i = "i_$e->{NAME}_$l->{LEVEL_INDEX}"; - pidl "for ($i=0; $i<$len;$i++) {"; - indent; - ParseElementLevel($e,$nl,$env,$varname."[$i]",$what,$align); - deindent; - pidl "}"; -} - -sub ParseElementLevelSwitch($$$$$$$) -{ - my ($e,$l,$nl,$env,$varname,$what,$align) = @_; - - ParseElementLevel($e,$nl,$env,$varname,$what,$align); -} - -sub ParseElementLevelPtr($$$$$$$) -{ - my ($e,$l,$nl,$env,$varname,$what,$align) = @_; - - if ($what == PRIMITIVES) { - if (($l->{POINTER_TYPE} eq "ref") and ($l->{LEVEL} eq "EMBEDDED")) { - # Ref pointers always have to be non-NULL - pidl "if (MARSHALLING(ps) && !" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ")"; - pidl "\treturn False;"; - pidl ""; - } - - unless ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP") { - Align($align, 4); - pidl "if (!prs_uint32(\"ptr$l->{POINTER_INDEX}_$e->{NAME}\", ps, depth, &" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . "))"; - pidl "\treturn False;"; - pidl ""; - } - } - - if ($l->{POINTER_TYPE} eq "relative") { - fatal($e, "relative pointers not supported for Samba 3"); - #FIXME - } - - if ($what == DEFERRED) { - if ($l->{POINTER_TYPE} ne "ref") { - pidl "if (" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . ") {"; - indent; - } - ParseElementLevel($e,$nl,$env,$varname,PRIMITIVES,$align); - ParseElementLevel($e,$nl,$env,$varname,DEFERRED,$align); - if ($l->{POINTER_TYPE} ne "ref") { - deindent; - pidl "}"; - } - $$align = 0; - } -} - -sub ParseElementLevelSubcontext($$$$$$$) -{ - my ($e,$l,$nl,$env,$varname,$what,$align) = @_; - - fatal($e, "subcontext() not supported for Samba 3"); - #FIXME -} - -sub ParseElementLevel($$$$$$) -{ - my ($e,$l,$env,$varname,$what,$align) = @_; - - { - DATA => \&ParseElementLevelData, - SUBCONTEXT => \&ParseElementLevelSubcontext, - POINTER => \&ParseElementLevelPtr, - SWITCH => \&ParseElementLevelSwitch, - ARRAY => \&ParseElementLevelArray - }->{$l->{TYPE}}->($e,$l,GetNextLevel($e,$l),$env,$varname,$what,$align); -} - -sub ParseElement($$$$) -{ - my ($e,$env,$what,$align) = @_; - - ParseElementLevel($e, $e->{LEVELS}[0], $env, ParseExpr($e->{NAME}, $env), $what, $align); -} - -sub InitLevel($$$$) -{ - sub InitLevel($$$$); - my ($e,$l,$varname,$env) = @_; - - if ($l->{TYPE} eq "POINTER") { - if ($l->{POINTER_TYPE} eq "ref") { - pidl "if (!$varname)"; - pidl "\treturn False;"; - pidl ""; - } else { - pidl "if ($varname) {"; - indent; - } - - unless ($l->{POINTER_TYPE} eq "ref" and $l->{LEVEL} eq "TOP") { - pidl ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 1;"; - } - InitLevel($e, GetNextLevel($e,$l), "*$varname", $env); - - if ($l->{POINTER_TYPE} ne "ref") { - deindent; - pidl "} else {"; - pidl "\t" . ParseExpr("ptr$l->{POINTER_INDEX}_$e->{NAME}", $env) . " = 0;"; - pidl "}"; - } - } elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_ZERO_TERMINATED}) { - my ($t,$f) = StringType($e,$l); - pidl "init_$t(&" . ParseExpr($e->{NAME}, $env) . ", ".substr($varname, 1) . ", $f);"; - } elsif ($l->{TYPE} eq "ARRAY") { - pidl ParseExpr($e->{NAME}, $env) . " = $varname;"; - } elsif ($l->{TYPE} eq "DATA") { - pidl InitType($e, $l, ParseExpr($e->{NAME}, $env), $varname); - } elsif ($l->{TYPE} eq "SWITCH") { - InitLevel($e, GetNextLevel($e,$l), $varname, $env); - pidl ParseExpr($e->{NAME}, $env) . ".switch_value = " . ParseExpr($l->{SWITCH_IS}, $env) . ";"; - } -} - -sub GenerateEnvElement($$) -{ - my ($e,$env) = @_; - foreach my $l (@{$e->{LEVELS}}) { - if ($l->{TYPE} eq "DATA") { - $env->{$e->{NAME}} = "v->$e->{NAME}"; - } elsif ($l->{TYPE} eq "POINTER") { - $env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}_$e->{NAME}"; - } elsif ($l->{TYPE} eq "SWITCH") { - } elsif ($l->{TYPE} eq "ARRAY" and not $l->{IS_ZERO_TERMINATED}) { - $env->{"length_$e->{NAME}"} = "v->length_$e->{NAME}"; - $env->{"size_$e->{NAME}"} = "v->size_$e->{NAME}"; - $env->{"offset_$e->{NAME}"} = "v->offset_$e->{NAME}"; - } - } -} - -sub ParseStruct($$$) -{ - my ($if,$s,$n) = @_; - - my $fn = "$if->{NAME}_io_$n"; - my $sn = uc("$if->{NAME}_$n"); - my $ifn = "init_$if->{NAME}_$n"; - - my $args = ""; - foreach (@{$s->{ELEMENTS}}) { - $args .= ", " . DeclLong($_); - } - - my $env = { "this" => "v" }; - GenerateEnvElement($_, $env) foreach (@{$s->{ELEMENTS}}); - - pidl "BOOL $ifn($sn *v$args)"; - pidl "{"; - indent; - pidl "DEBUG(5,(\"$ifn\\n\"));"; - pidl ""; - # Call init for all arguments - foreach (@{$s->{ELEMENTS}}) { - InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env); - pidl ""; - } - pidl "return True;"; - deindent; - pidl "}"; - pidl ""; - - my $pfn = "$fn\_p"; - my $dfn = "$fn\_d"; - - pidl "BOOL $pfn(const char *desc, $sn *v, prs_struct *ps, int depth)"; - pidl "{"; - indent; - DeclareArrayVariables($s->{ELEMENTS}, PRIMITIVES); - pidl "if (v == NULL)"; - pidl "\treturn False;"; - pidl ""; - pidl "prs_debug(ps, depth, desc, \"$pfn\");"; - pidl "depth++;"; - - my $align = 8; - if ($s->{SURROUNDING_ELEMENT}) { - pidl "if (!prs_uint32(\"size_$s->{SURROUNDING_ELEMENT}->{NAME}\", ps, depth, &" . ParseExpr("size_$s->{SURROUNDING_ELEMENT}->{NAME}", $env) . "))"; - pidl "\treturn False;"; - pidl ""; - $align = 4; - - } - - foreach (@{$s->{ELEMENTS}}) { - ParseElement($_, $env, PRIMITIVES, \$align); - pidl ""; - } - - pidl "return True;"; - deindent; - pidl "}"; - pidl ""; - - pidl "BOOL $dfn(const char *desc, $sn *v, prs_struct *ps, int depth)"; - pidl "{"; - indent; - DeclareArrayVariables($s->{ELEMENTS}, DEFERRED); - pidl "if (v == NULL)"; - pidl "\treturn False;"; - pidl ""; - pidl "prs_debug(ps, depth, desc, \"$dfn\");"; - pidl "depth++;"; - - $align = 0; - foreach (@{$s->{ELEMENTS}}) { - ParseElement($_, $env, DEFERRED, \$align); - pidl ""; - } - - pidl "return True;"; - deindent; - pidl "}"; - pidl ""; -} - -sub UnionGenerateEnvElement($) -{ - my $e = shift; - my $env = {}; - - foreach my $l (@{$e->{LEVELS}}) { - if ($l->{TYPE} eq "DATA") { - $env->{$e->{NAME}} = "v->u.$e->{NAME}"; - } elsif ($l->{TYPE} eq "POINTER") { - $env->{"ptr$l->{POINTER_INDEX}_$e->{NAME}"} = "v->ptr$l->{POINTER_INDEX}"; - } elsif ($l->{TYPE} eq "SWITCH") { - } elsif ($l->{TYPE} eq "ARRAY" and not $l->{IS_ZERO_TERMINATED}) { - $env->{"length_$e->{NAME}"} = "v->length"; - $env->{"size_$e->{NAME}"} = "v->size"; - $env->{"offset_$e->{NAME}"} = "v->offset"; - } - } - - return $env; -} - -sub ParseUnion($$$) -{ - my ($if,$u,$n) = @_; - - my $fn = "$if->{NAME}_io_$n"; - my $sn = uc("$if->{NAME}_$n\_ctr"); - - my $pfn = "$fn\_p"; - my $dfn = "$fn\_d"; - - pidl "BOOL $pfn(const char *desc, $sn* v, prs_struct *ps, int depth)"; - pidl "{"; - indent; - DeclareArrayVariables($u->{ELEMENTS}); - - if (defined ($u->{SWITCH_TYPE})) { - pidl "if (!prs_$u->{SWITCH_TYPE}(\"switch_value\", ps, depth, &v->switch_value))"; - pidl "\treturn False;"; - pidl ""; - } - - # Maybe check here that level and v->switch_value are equal? - - pidl "switch (v->switch_value) {"; - indent; - - foreach (@{$u->{ELEMENTS}}) { - pidl "$_->{CASE}:"; - indent; - if ($_->{TYPE} ne "EMPTY") { - pidl "depth++;"; - my $env = UnionGenerateEnvElement($_); - my $align = 8; - ParseElement($_, $env, PRIMITIVES, \$align); - pidl "depth--;"; - } - pidl "break;"; - deindent; - pidl ""; - } - - unless ($u->{HAS_DEFAULT}) { - pidl "default:"; - pidl "\treturn False;"; - pidl ""; - } - - deindent; - pidl "}"; - pidl ""; - pidl "return True;"; - deindent; - pidl "}"; - pidl ""; - - pidl "BOOL $dfn(const char *desc, $sn* v, prs_struct *ps, int depth)"; - pidl "{"; - indent; - DeclareArrayVariables($u->{ELEMENTS}); - - if (defined($u->{SWITCH_TYPE})) { - pidl "switch (v->switch_value) {"; - } else { - pidl "switch (level) {"; - } - indent; - - foreach (@{$u->{ELEMENTS}}) { - pidl "$_->{CASE}:"; - indent; - if ($_->{TYPE} ne "EMPTY") { - pidl "depth++;"; - my $env = UnionGenerateEnvElement($_); - my $align = 0; - ParseElement($_, $env, DEFERRED, \$align); - pidl "depth--;"; - } - pidl "break;"; - deindent; - pidl ""; - } - - deindent; - pidl "}"; - pidl ""; - pidl "return True;"; - deindent; - pidl "}"; - -} - -sub CreateFnDirection($$$$$) -{ - my ($fn,$ifn,$s,$all,$es) = @_; - - my $args = ""; - foreach (@$all) { $args .= ", " . DeclLong($_); } - - my $env = { }; - GenerateEnvElement($_, $env) foreach (@$es); - - pidl "BOOL $ifn($s *v$args)"; - pidl "{"; - indent; - pidl "DEBUG(5,(\"$ifn\\n\"));"; - pidl ""; - # Call init for all arguments - foreach (@$es) { - InitLevel($_, $_->{LEVELS}[0], $_->{NAME}, $env); - pidl ""; - } - pidl "return True;"; - deindent; - pidl "}"; - pidl ""; - - pidl "BOOL $fn(const char *desc, $s *v, prs_struct *ps, int depth)"; - pidl "{"; - indent; - DeclareArrayVariables($es); - pidl "if (v == NULL)"; - pidl "\treturn False;"; - pidl ""; - pidl "prs_debug(ps, depth, desc, \"$fn\");"; - pidl "depth++;"; - - my $align = 8; - foreach (@$es) { - ParseElement($_, $env, PRIMITIVES, \$align); - ParseElement($_, $env, DEFERRED, \$align); - pidl ""; - } - - pidl "return True;"; - deindent; - pidl "}"; - pidl ""; -} - -sub ParseFunction($$) -{ - my ($if,$fn) = @_; - - my @in = (); - my @out = (); - my @all = @{$fn->{ELEMENTS}}; - - foreach (@{$fn->{ELEMENTS}}) { - push (@in, $_) if (grep(/in/, @{$_->{DIRECTION}})); - push (@out, $_) if (grep(/out/, @{$_->{DIRECTION}})); - } - - if (defined($fn->{RETURN_TYPE})) { - my $status = { - NAME => "status", - TYPE => $fn->{RETURN_TYPE}, - LEVELS => [ - { - TYPE => "DATA", - DATA_TYPE => $fn->{RETURN_TYPE} - } - ] - }; - - push (@out, $status); - push (@all, $status); - } - - CreateFnDirection("$if->{NAME}_io_q_$fn->{NAME}", - "init_$if->{NAME}_q_$fn->{NAME}", - uc("$if->{NAME}_q_$fn->{NAME}"), - \@in, \@in); - CreateFnDirection("$if->{NAME}_io_r_$fn->{NAME}", - "init_$if->{NAME}_r_$fn->{NAME}", - uc("$if->{NAME}_r_$fn->{NAME}"), - \@all, \@out); -} - -sub ParseInterface($) -{ - my $if = shift; - - # Structures first - pidl "/* $if->{NAME} structures */"; - foreach (@{$if->{TYPES}}) { - ParseStruct($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "STRUCT"); - ParseUnion($if, $_->{DATA}, $_->{NAME}) if ($_->{DATA}->{TYPE} eq "UNION"); - } - - pidl "/* $if->{NAME} functions */"; - ParseFunction($if, $_) foreach (@{$if->{FUNCTIONS}}); -} - -sub Parse($$) -{ - my($ndr,$filename) = @_; - - $tabs = ""; - $res = ""; - - pidl "/*"; - pidl " * Unix SMB/CIFS implementation."; - pidl " * parser auto-generated by pidl. DO NOT MODIFY!"; - pidl " */"; - pidl ""; - pidl "#include \"includes.h\""; - pidl ""; - pidl "#undef DBGC_CLASS"; - pidl "#define DBGC_CLASS DBGC_RPC_PARSE"; - pidl ""; - - foreach (@$ndr) { - ParseInterface($_) if ($_->{TYPE} eq "INTERFACE"); - } - - return $res; -} - -1; diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Template.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Template.pm deleted file mode 100644 index 47d565dce6..0000000000 --- a/source4/pidl/lib/Parse/Pidl/Samba3/Template.pm +++ /dev/null @@ -1,82 +0,0 @@ -################################################### -# Samba3 NDR client generator for IDL structures -# Copyright jelmer@samba.org 2005 -# released under the GNU GPL - -package Parse::Pidl::Samba3::Template; - -use strict; -use Parse::Pidl::Typelist qw(hasType getType mapType); -use Parse::Pidl::Util qw(has_property ParseExpr); -use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred); - -use vars qw($VERSION); -$VERSION = '0.01'; - -my $res; -sub pidl($) { my $x = shift; $res.="$x\n"; } - -sub ParseInterface($) -{ - my $if = shift; - - foreach (@{$if->{FUNCTIONS}}) { - my $ret = $_->{RETURN_TYPE}; - if (not $ret) { $ret = "void"; } - pidl "$ret _$_->{NAME}(pipes_struct *p, " . uc($if->{NAME}) . "_Q_" . uc($_->{NAME}) . " *q_u, " . uc($if->{NAME}) . "_R_" . uc($_->{NAME}) . " *r_u)"; - pidl "{"; - pidl "\t/* FIXME: Implement your code here */"; - if (not defined($_->{RETURN_TYPE})) { - } elsif ($_->{RETURN_TYPE} eq "WERROR") { - pidl "\treturn WERR_NOT_SUPPORTED;"; - } elsif ($_->{RETURN_TYPE} eq "NTSTATUS") { - pidl "\treturn NT_STATUS_NOT_IMPLEMENTED;"; - } elsif ($_->{RETURN_TYPE} eq "uint32") { - pidl "\treturn 0;"; - } - pidl "}"; - pidl ""; - } -} - -sub Parse($$) -{ - my($ndr,$filename) = @_; - - $res = ""; - - pidl "/* - * Unix SMB/CIFS implementation. - **** template auto-generated by pidl. Modify to your needs **** - * RPC Pipe client / server routines - * Copyright (C) YOUR NAME YEAR. - * - * This program is free software; you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation; either version 2 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; if not, write to the Free Software - * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. - */ - -#include \"includes.h\" - -#undef DBGC_CLASS -#define DBGC_CLASS DBGC_MSRPC -"; - - foreach (@$ndr) { - ParseInterface($_) if ($_->{TYPE} eq "INTERFACE"); - } - - return $res; -} - -1; diff --git a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm b/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm deleted file mode 100644 index 666d23e669..0000000000 --- a/source4/pidl/lib/Parse/Pidl/Samba3/Types.pm +++ /dev/null @@ -1,403 +0,0 @@ -################################################### -# Samba3 type-specific declarations / initialization / marshalling -# Copyright jelmer@samba.org 2005 -# released under the GNU GPL - -package Parse::Pidl::Samba3::Types; - -require Exporter; -@ISA = qw(Exporter); -@EXPORT_OK = qw(DeclShort DeclLong InitType DissectType AddType StringType); - -use strict; -use Parse::Pidl::Util qw(has_property ParseExpr property_matches); -use Parse::Pidl::NDR qw(GetPrevLevel GetNextLevel ContainsDeferred ContainsString); - -use vars qw($VERSION); -$VERSION = '0.01'; - -# TODO: Find external types somehow? - -sub warning($$) { my ($e,$s) = @_; print STDERR "$e->{ORIGINAL}->{FILE}:$e->{ORIGINAL}->{LINE}: $s\n"; } - -sub init_scalar($$$$) -{ - my ($e,$l,$n,$v) = @_; - - return "$n = $v;"; -} - -sub dissect_scalar($$$$$) -{ - my ($e,$l,$n,$w,$a) = @_; - - my $t = lc($e->{TYPE}); - - return "prs_$t(\"$e->{NAME}\", ps, depth, &$n)"; -} - -sub decl_string($) -{ - my $e = shift; - - my $is_conformant = property_matches($e, "flag", ".*STR_SIZE4.*"); - my $is_varying = property_matches($e, "flag", ".*STR_LEN4.*"); - my $is_ascii = property_matches($e, "flag", ".*STR_ASCII.*"); - - return "STRING2" if ($is_conformant and $is_varying and $is_ascii); - - return "UNISTR2" if ($is_conformant and $is_varying); - return "UNISTR3" if ($is_varying); - # We don't do UNISTR4, as we have lsa_String for that in Samba4's IDL - - die("Don't know what string type to use"); -} - -sub contains_pointer($) -{ - my $e = shift; - - foreach my $l (@{$e->{LEVELS}}) { - return 1 if ($l->{TYPE} eq "POINTER"); - } - - return 0; -} - -sub ext_decl_string($) -{ - my $e = shift; - - # One pointer is sufficient.. - return "const char" if (contains_pointer($e)); - return "const char *"; -} - -sub init_string($$$$) -{ - my ($e,$l,$n,$v) = @_; - - my $t = lc(decl_string($e)); - - my $flags; - if (property_matches($e, "flag", ".*STR_NULLTERM.*")) { - $flags = "UNI_STR_TERMINATE"; - } elsif (property_matches($e, "flag", ".*STR_NOTERM.*")) { - $flags = "UNI_STR_NOTERM"; - } else { - $flags = "UNI_FLAGS_NONE"; - } - - # One pointer is sufficient - if (substr($v, 0, 1) eq "*") { $v = substr($v, 1); } - - return "init_$t(&$n, $v, $flags);"; -} - -sub dissect_string($$$$$) -{ - my ($e,$l,$n,$w,$a) = @_; - - my $t = lc(decl_string($e)); - - $$a = 1; - return "smb_io_$t(\"$e->{NAME}\", &$n, 1, ps, depth)"; -} - -sub StringType($$) -{ - my ($e,$l) = @_; - my $nl = GetNextLevel($e,$l); - - if ($l->{IS_VARYING} and $l->{IS_CONFORMANT} and $nl->{DATA_TYPE} eq "uint16") { - return ("unistr2", "UNI_FLAGS_NONE"); - } elsif ($l->{IS_CONFORMANT} and $l->{IS_VARYING} and $nl->{DATA_TYPE} eq "uint8") { - return ("string2", 0); - } else { - fatal($e, "[string] non-varying string not supported for Samba3 yet"); - } -} - -my $known_types = -{ - uint8 => - { - DECL => "uint8", - INIT => \&init_scalar, - DISSECT_P => \&dissect_scalar, - }, - uint16 => - { - DECL => "uint16", - INIT => \&init_scalar, - DISSECT_P => \&dissect_scalar, - }, - uint32 => - { - DECL => "uint32", - INIT => \&init_scalar, - DISSECT_P => \&dissect_scalar, - }, - uint64 => - { - DECL => "uint64", - INIT => \&init_scalar, - DISSECT_P => \&dissect_scalar, - }, - int32 => - { - DECL => "int32", - INIT => \&init_scalar, - DISSECT_P => \&dissect_scalar, - }, - string => - { - DECL => \&decl_string, - EXT_DECL => \&ext_decl_string, - INIT => \&init_string, - DISSECT_P => \&dissect_string, - }, - NTSTATUS => - { - DECL => "NTSTATUS", - INIT => \&init_scalar, - DISSECT_P => \&dissect_scalar, - }, - WERROR => - { - DECL => "WERROR", - INIT => \&init_scalar, - DISSECT_P => \&dissect_scalar, - }, - GUID => - { - DECL => "struct uuid", - INIT => "", - DISSECT_P => sub { - my ($e,$l,$n) = @_; - return "smb_io_uuid(\"$e->{NAME}\", &$n, ps, depth)"; - } - }, - NTTIME => - { - DECL => "NTTIME", - INIT => "", - DISSECT_P => sub { - my ($e,$l,$n,$w,$a) = @_; - return "smb_io_nttime(\"$e->{NAME}\", &n, ps, depth)"; - } - }, - dom_sid => - { - DECL => "DOM_SID", - INIT => "", - DISSECT_P => sub { - my ($e,$l,$n,$w,$a) = @_; - return "smb_io_dom_sid(\"$e->{NAME}\", &n, ps, depth)"; - } - }, - policy_handle => - { - DECL => "POLICY_HND", - INIT => "", - DISSECT_P => sub { - my ($e,$l,$n,$w,$a) = @_; - return "smb_io_pol_hnd(\"$e->{NAME}\", &n, ps, depth)"; - } - }, - security_descriptor => - { - DECL => "SEC_DESC", - INIT => "", - DISSECT_P => sub { - my ($e,$l,$n,$w,$a) = @_; - return "sec_io_desc(\"$e->{NAME}\", &n, ps, depth)"; - } - }, - hyper => - { - DECL => "uint64", - INIT => "", - DISSECT_P => sub { - my ($e,$l,$n,$w,$a) = @_; - return "prs_uint64(\"$e->{NAME}\", ps, depth, &$n)"; - } - }, -}; - -sub AddType($$) -{ - my ($t,$d) = @_; - - warn("Reregistering type $t") if (defined($known_types->{$t})); - - $known_types->{$t} = $d; -} - -# Return type without special stuff, as used in -# declarations for internal structs -sub DeclShort($) -{ - my $e = shift; - - my $t = $known_types->{$e->{TYPE}}; - - if (not $t) { - warning($e, "Can't declare unknown type `$e->{TYPE}'"); - return undef; - } - - my $p; - - # DECL can be a function - if (ref($t->{DECL}) eq "CODE") { - $p = $t->{DECL}->($e); - } else { - $p = $t->{DECL}; - } - - my $prefixes = ""; - my $suffixes = ""; - foreach my $l (@{$e->{LEVELS}}) { - if ($l->{TYPE} eq "ARRAY" and not $l->{IS_FIXED}) { - $prefixes = "*$prefixes"; - } elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED}) { - $suffixes.="[$l->{SIZE_IS}]"; - } - } - - return "$p $prefixes$e->{NAME}$suffixes"; -} - -# Return type including special stuff (pointers, etc). -sub DeclLong($) -{ - my $e = shift; - - my $t = $known_types->{$e->{TYPE}}; - - if (not $t) { - warning($e, "Can't declare unknown type `$e->{TYPE}'"); - return undef; - } - - my $p; - - if (defined($t->{EXT_DECL})) { - $p = $t->{EXT_DECL} - } else { - $p = $t->{DECL}; - } - - if (ref($p) eq "CODE") { - $p = $p->($e); - } - - my $prefixes = ""; - my $suffixes = ""; - - foreach my $l (@{$e->{LEVELS}}) { - if ($l->{TYPE} eq "ARRAY" and $l->{IS_ZERO_TERMINATED}) { - $p = "const char"; - last; - } elsif ($l->{TYPE} eq "ARRAY" and not $l->{IS_FIXED}) { - $prefixes = "*$prefixes"; - } elsif ($l->{TYPE} eq "ARRAY" and $l->{IS_FIXED}) { - $suffixes.="[$l->{SIZE_IS}]"; - } elsif ($l->{TYPE} eq "POINTER") { - $prefixes = "*$prefixes"; - } - } - - return "$p $prefixes$e->{NAME}$suffixes"; -} - -sub InitType($$$$) -{ - my ($e, $l, $varname, $value) = @_; - - my $t = $known_types->{$l->{DATA_TYPE}}; - - 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") { - return $t->{INIT}->($e, $l, $varname, $value); - } else { - return $t->{INIT}; - } -} - -sub DissectType($$$$$) -{ - my ($e,$l,$varname,$what,$align) = @_; - - my $t = $known_types->{$l->{DATA_TYPE}}; - - if (not $t) { - warning($e, "Don't know how to dissect type $l->{DATA_TYPE}"); - return undef; - } - - my $dissect; - if ($what == 1) { #primitives - $dissect = $t->{DISSECT_P}; - } elsif ($what == 2) { - $dissect = $t->{DISSECT_D}; - } - - return "" if not defined($dissect); - - # DISSECT can be a function - if (ref($dissect) eq "CODE") { - return $dissect->($e,$l,$varname,$what,$align); - } else { - return $dissect; - } -} - -sub LoadTypes($) -{ - my $ndr = shift; - foreach my $if (@{$ndr}) { - next unless ($if->{TYPE} eq "INTERFACE"); - - foreach my $td (@{$if->{TYPES}}) { - my $decl = uc("$if->{NAME}_$td->{NAME}"); - - my $init = sub { - my ($e,$l,$n,$v) = @_; - return "$n = $v;"; - }; - - my $dissect_d; - my $dissect_p; - if ($td->{DATA}->{TYPE} eq "UNION") { - $decl.="_CTR"; - } - - $dissect_p = sub { - my ($e,$l,$n,$w,$a) = @_; - - return "$if->{NAME}_io_$td->{NAME}_p(\"$e->{NAME}\", &$n, ps, depth)"; - }; - $dissect_d = sub { - my ($e,$l,$n,$w,$a) = @_; - - return "$if->{NAME}_io_$td->{NAME}_d(\"$e->{NAME}\", &$n, ps, depth)"; - }; - - AddType($td->{NAME}, { - DECL => $decl, - INIT => $init, - DISSECT_D => $dissect_d, - DISSECT_P => $dissect_p - }); - } - } -} - -1; |