Commit 5756edfb authored by Russ Fish's avatar Russ Fish

Sync copies of the xmlfields code, before I forget why they're different.

parent 24ffb396
...@@ -168,7 +168,8 @@ my %errors = (); ...@@ -168,7 +168,8 @@ my %errors = ();
# #
# Make sure all the required arguments were provided. # Make sure all the required arguments were provided.
# #
foreach my $key (keys(%xmlfields)) { my $key;
foreach $key (keys(%xmlfields)) {
my (undef, $required, undef) = @{$xmlfields{$key}}; my (undef, $required, undef) = @{$xmlfields{$key}};
$errors{$key} = "Required value not provided" $errors{$key} = "Required value not provided"
...@@ -184,20 +185,60 @@ UserError() ...@@ -184,20 +185,60 @@ UserError()
# #
my %editexp_args = (); my %editexp_args = ();
foreach my $key (keys(%{ $xmlparse->{'attribute'} })) { #
# Wildcard keys have one or more *'s in them like simple glob patterns.
# This allows multiple key instances for categories of attributes, and
# putting a "type signature" in the key for arg checking, as well.
#
# Wildcards are made into regex's by anchoring the ends and changing each * to
# a "word" (group of alphahumeric.) A tail * means "the rest", allowing
# multiple words separated by underscores or dashes.
#
my $wordpat = '[a-zA-Z0-9]+';
my $tailpat = '[-\w]+';
my %wildcards;
foreach $key (keys(%xmlfields)) {
if (index($key, "*") >= 0) {
my $regex = '^' . $key . '$';
$regex =~ s/\*\$$/$tailpat/;
$regex =~ s/\*/$wordpat/g;
$wildcards{$key} = $regex;
}
}
# Key ordering is lost in a hash.
# Put longer matching wildcard keys before their prefix.
my @wildkeys = reverse(sort(keys(%wildcards)));
foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'}; my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
if (!defined($value)) { # Empty string comes from XML as an undef value. if (!defined($value)) { # Empty string comes from XML as an undef value.
$xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = ""; $xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = "";
} }
if ($debug) { print STDERR "User attribute: '$key' -> '$value'\n"
print STDERR "User attribute: '$key' -> '$value'\n"; if ($debug);
}
my $field = $key;
my $wild;
if (!exists($xmlfields{$key})) {
$errors{$key} = "Unknown attribute" # Not a regular key; look for a wildcard regex match.
if (!exists($xmlfields{$key})); foreach my $wildkey (@wildkeys) {
my $regex = $wildcards{$wildkey};
if ($wild = $key =~ /$regex/) {
$field = $wildkey;
print STDERR "Wildcard: '$key' matches '$wildkey'\n"
if ($debug);
last; # foreach $wildkey
}
}
if (!$wild) {
$errors{$key} = "Unknown attribute";
next; # foreach $key
}
}
my ($dbslot, $required, $default) = @{$xmlfields{$key}}; my ($dbslot, $required, $default) = @{$xmlfields{$field}};
if ($required & $SLOT_REQUIRED) { if ($required & $SLOT_REQUIRED) {
# A slot that must be provided, so do not allow a null value. # A slot that must be provided, so do not allow a null value.
...@@ -228,7 +269,7 @@ foreach my $key (keys(%{ $xmlparse->{'attribute'} })) { ...@@ -228,7 +269,7 @@ foreach my $key (keys(%{ $xmlparse->{'attribute'} })) {
next; next;
} }
$editexp_args{$dbslot} = $value; $editexp_args{$key} = $value;
} }
UserError() UserError()
if (keys(%errors)); if (keys(%errors));
...@@ -238,7 +279,7 @@ UserError() ...@@ -238,7 +279,7 @@ UserError()
# #
my $doemail = 0; my $doemail = 0;
my $experiment = Experiment->Lookup($editexp_args{"eid_idx"}); my $experiment = Experiment->Lookup($editexp_args{"experiment"});
if (!defined($experiment)) { if (!defined($experiment)) {
UserError("Experiment: No such experiment"); UserError("Experiment: No such experiment");
} }
......
...@@ -128,8 +128,15 @@ my $SLOT_ADMINONLY = 0x4; # Only admins can set this field. ...@@ -128,8 +128,15 @@ my $SLOT_ADMINONLY = 0x4; # Only admins can set this field.
# #
my %xmlfields = my %xmlfields =
# XML Field Name DB slot name Flags Default # XML Field Name DB slot name Flags Default
("group" => ["gid_idx", $SLOT_REQUIRED]); ("group" => ["gid_idx", $SLOT_REQUIRED],
# And also trust args, see below.
# Trust args, either:
# (change|add)_xxx=permit or
# Uxxx$$trust=(user|local_root|group_root)
# where xxx is the uid_idx of a user.
"change_*" => ["change", $SLOT_OPTIONAL],
"add_*" => ["add", $SLOT_OPTIONAL],
"U*\\\$\\\$trust" => ["trust", $SLOT_OPTIONAL]);
# #
# Must wrap the parser in eval since it exits on error. # Must wrap the parser in eval since it exits on error.
...@@ -168,36 +175,60 @@ UserError() ...@@ -168,36 +175,60 @@ UserError()
# #
my %editgroup_args = (); my %editgroup_args = ();
#
# Wildcard keys have one or more *'s in them like simple glob patterns.
# This allows multiple key instances for categories of attributes, and
# putting a "type signature" in the key for arg checking, as well.
#
# Wildcards are made into regex's by anchoring the ends and changing each * to
# a "word" (group of alphahumeric.) A tail * means "the rest", allowing
# multiple words separated by underscores or dashes.
#
my $wordpat = '[a-zA-Z0-9]+';
my $tailpat = '[-\w]+';
my %wildcards;
foreach $key (keys(%xmlfields)) {
if (index($key, "*") >= 0) {
my $regex = '^' . $key . '$';
$regex =~ s/\*\$$/$tailpat/;
$regex =~ s/\*/$wordpat/g;
$wildcards{$key} = $regex;
}
}
# Key ordering is lost in a hash.
# Put longer matching wildcard keys before their prefix.
my @wildkeys = reverse(sort(keys(%wildcards)));
foreach $key (keys(%{ $xmlparse->{'attribute'} })) { foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'}; my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
if (!defined($value)) { # Empty string comes from XML as an undef value. if (!defined($value)) { # Empty string comes from XML as an undef value.
$xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = ""; $xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = "";
} }
if ($debug) { print STDERR "User attribute: '$key' -> '$value'\n"
print STDERR "User attribute: '$key' -> '$value'\n"; if ($debug);
my $field = $key;
my $wild;
if (!exists($xmlfields{$key})) {
# Not a regular key; look for a wildcard regex match.
foreach my $wildkey (@wildkeys) {
my $regex = $wildcards{$wildkey};
if ($wild = $key =~ /$regex/) {
$field = $wildkey;
print STDERR "Wildcard: '$key' matches '$wildkey'\n"
if ($debug);
last; # foreach $wildkey
} }
# XXX Special for trust args. Either:
# (change|add)_xxx=permit or
# Uxxx$$trust=(user|(local|group)_root)
# where xxx is the uid_idx of a user.
if (($key =~ /^(change|add)_[0-9]+$/ &&
$value eq "permit") ||
($key =~ /^U[0-9]+\$\$trust$/ &&
$value =~ /^(user|(local|group)_root)$/)) {
if ($debug) {
print STDERR "Trust: '$key' -> '$value'\n";
} }
$editgroup_args{$key} = $value; if (!$wild) {
next; $errors{$key} = "Unknown attribute";
next; # foreach $key
}
} }
$errors{$key} = "Unknown attribute" my ($dbslot, $required, $default) = @{$xmlfields{$field}};
if (!exists($xmlfields{$key}));
my ($dbslot, $required, $default) = @{$xmlfields{$key}};
if ($required & $SLOT_REQUIRED) { if ($required & $SLOT_REQUIRED) {
# A slot that must be provided, so do not allow a null value. # A slot that must be provided, so do not allow a null value.
...@@ -222,12 +253,13 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) { ...@@ -222,12 +253,13 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
} }
# Now check that the value is legal. # Now check that the value is legal.
if (! TBcheck_dbslot($value, "groups", $dbslot, TBDB_CHECKDBSLOT_ERROR)) { if (! TBcheck_dbslot($value, "groups",
$dbslot, TBDB_CHECKDBSLOT_ERROR)) {
$errors{$key} = TBFieldErrorString(); $errors{$key} = TBFieldErrorString();
next; next;
} }
$editgroup_args{$dbslot} = $value; $editgroup_args{$key} = $value;
} }
UserError() UserError()
if (keys(%errors)); if (keys(%errors));
...@@ -235,7 +267,7 @@ UserError() ...@@ -235,7 +267,7 @@ UserError()
# #
# Now do special checks. # Now do special checks.
# #
my $group = Group->Lookup($editgroup_args{"gid_idx"}); my $group = Group->Lookup($editgroup_args{"group"});
if (!defined($group)) { if (!defined($group)) {
UserError("Group: No such group"); UserError("Group: No such group");
} }
...@@ -254,7 +286,7 @@ exit(0) ...@@ -254,7 +286,7 @@ exit(0)
# We pass the group along as an argument to EditGroup(), so remove it from # We pass the group along as an argument to EditGroup(), so remove it from
# the argument array. # the argument array.
# #
delete($editgroup_args{"gid_idx"}); delete($editgroup_args{"group"});
my $usrerr; my $usrerr;
my $editgroup_val = Group->EditGroup($group, $this_user, my $editgroup_val = Group->EditGroup($group, $this_user,
......
...@@ -138,9 +138,9 @@ my %xmlfields = ...@@ -138,9 +138,9 @@ my %xmlfields =
# The rest are optional, so we can skip passing ones that are not changing. # The rest are optional, so we can skip passing ones that are not changing.
"description" => ["description", $SLOT_OPTIONAL], "description" => ["description", $SLOT_OPTIONAL],
"path" => ["path", $SLOT_OPTIONAL], "path" => ["path", $SLOT_OPTIONAL],
"mtype_*" => ["mtype", $SLOT_OPTIONAL],
"load_address" => ["load_address", $SLOT_ADMINONLY], "load_address" => ["load_address", $SLOT_ADMINONLY],
"frisbee_pid" => ["frisbee_pid", $SLOT_ADMINONLY]); "frisbee_pid" => ["frisbee_pid", $SLOT_ADMINONLY]);
# The "mtype_$type" node type booleans are handled below...
# #
# Need a list of node types. We join this over the nodes table so that # Need a list of node types. We join this over the nodes table so that
# we get a list of just the nodes that are currently in the testbed, not # we get a list of just the nodes that are currently in the testbed, not
...@@ -199,38 +199,60 @@ UserError() ...@@ -199,38 +199,60 @@ UserError()
my %editimageid_args = (); my %editimageid_args = ();
my $foo; my $foo;
#
# Wildcard keys have one or more *'s in them like simple glob patterns.
# This allows multiple key instances for categories of attributes, and
# putting a "type signature" in the key for arg checking, as well.
#
# Wildcards are made into regex's by anchoring the ends and changing each * to
# a "word" (group of alphahumeric.) A tail * means "the rest", allowing
# multiple words separated by underscores or dashes.
#
my $wordpat = '[a-zA-Z0-9]+';
my $tailpat = '[-\w]+';
my %wildcards;
foreach $key (keys(%xmlfields)) {
if (index($key, "*") >= 0) {
my $regex = '^' . $key . '$';
$regex =~ s/\*\$$/$tailpat/;
$regex =~ s/\*/$wordpat/g;
$wildcards{$key} = $regex;
}
}
# Key ordering is lost in a hash.
# Put longer matching wildcard keys before their prefix.
my @wildkeys = reverse(sort(keys(%wildcards)));
foreach $key (keys(%{ $xmlparse->{'attribute'} })) { foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'}; my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
if (!defined($value)) { # Empty string comes from XML as an undef value. if (!defined($value)) { # Empty string comes from XML as an undef value.
$xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = ""; $xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = "";
} }
if ($debug) { print STDERR "User attribute: '$key' -> '$value'\n"
print STDERR "User attribute: '$key' -> '$value'\n";
}
# XXX Special for mtype_* args, since the keys are dynamically generated.
if ($key =~ /^mtype_[\w]+$/) {
print STDERR "mtype: '$key' -> '$value'\n"
if ($debug); if ($debug);
my $type = $key; my $field = $key;
$type =~ s/^mtype_//; my $wild;
my $match = grep(/^${type}$/, @mtypes_array); if (!exists($xmlfields{$key})) {
$errors{$key} = "Illegal node type."
if ($match == 0);
$errors{$key} = "Illegal characters in boolean value" # Not a regular key; look for a wildcard regex match.
if ($value ne "0" && $value ne "1"); foreach my $wildkey (@wildkeys) {
my $regex = $wildcards{$wildkey};
$editimageid_args{$key} = $value; if ($wild = $key =~ /$regex/) {
next; $field = $wildkey;
print STDERR "Wildcard: '$key' matches '$wildkey'\n"
if ($debug);
last; # foreach $wildkey
}
}
if (!$wild) {
$errors{$key} = "Unknown attribute";
next; # foreach $key
}
} }
$errors{$key} = "Unknown attribute" my ($dbslot, $required, $default) = @{$xmlfields{$field}};
if (!exists($xmlfields{$key}));
my ($dbslot, $required, $default) = @{$xmlfields{$key}};
if ($required & $SLOT_REQUIRED) { if ($required & $SLOT_REQUIRED) {
# A slot that must be provided, so do not allow a null value. # A slot that must be provided, so do not allow a null value.
...@@ -255,12 +277,13 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) { ...@@ -255,12 +277,13 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
} }
# Now check that the value is legal. # Now check that the value is legal.
if (! TBcheck_dbslot($value, "images", $dbslot, TBDB_CHECKDBSLOT_ERROR)) { if (! TBcheck_dbslot($value, "images",
$dbslot, TBDB_CHECKDBSLOT_ERROR)) {
$errors{$key} = TBFieldErrorString(); $errors{$key} = TBFieldErrorString();
next; next;
} }
$editimageid_args{$dbslot} = $value; $editimageid_args{$key} = $value;
} }
UserError() UserError()
if (keys(%errors)); if (keys(%errors));
...@@ -320,11 +343,32 @@ if (!$isadmin && exists($editimageid_args{"path"})) { ...@@ -320,11 +343,32 @@ if (!$isadmin && exists($editimageid_args{"path"})) {
# #
# See what node types this image will work on. Must be at least one! # See what node types this image will work on. Must be at least one!
if ($#mtypes_array < 0) { #
UserError("Node Types: Must have at least one node type"); UserError("Node Types: Must have at least one node type")
} if ($#mtypes_array < 0);
my $typeclause = join(" or ", map("type='$_'", @mtypes_array)); my $typeclause = join(" or ", map("type='$_'", @mtypes_array));
# Check validity of mtype_* args, since the keys are dynamically generated.
my $node_types_selected = 0;
my @mtype_keys = grep(/^mtype_/, keys(%editimageid_args));
foreach $key (@mtype_keys) {
my $value = $editimageid_args{$key};
print STDERR "mtype: '$key' -> '$value'\n"
if ($debug);
my $type = $key;
$type =~ s/^mtype_//;
my $match = grep(/^${type}$/, @mtypes_array);
if ($match == 0) {
$errors{$key} = "Illegal node type."
}
elsif ($value eq "1") {
$node_types_selected++;
}
}
UserError("Node Types: Must select at least one node type")
if ($node_types_selected == 0);
# #
# Only admins can edit the load_address or the frisbee pid. # Only admins can edit the load_address or the frisbee pid.
# #
......
...@@ -278,7 +278,8 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) { ...@@ -278,7 +278,8 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
} }
# Now check that the value is legal. # Now check that the value is legal.
if (! TBcheck_dbslot($value, "node_types", $dbslot, TBDB_CHECKDBSLOT_ERROR)) { if (! TBcheck_dbslot($value, "node_types",
$dbslot, TBDB_CHECKDBSLOT_ERROR)) {
$errors{$key} = TBFieldErrorString(); $errors{$key} = TBFieldErrorString();
next; next;
} }
......
...@@ -171,20 +171,60 @@ UserError() ...@@ -171,20 +171,60 @@ UserError()
# #
my %editsitevars_args = (); my %editsitevars_args = ();
#
# Wildcard keys have one or more *'s in them like simple glob patterns.
# This allows multiple key instances for categories of attributes, and
# putting a "type signature" in the key for arg checking, as well.
#
# Wildcards are made into regex's by anchoring the ends and changing each * to
# a "word" (group of alphahumeric.) A tail * means "the rest", allowing
# multiple words separated by underscores or dashes.
#
my $wordpat = '[a-zA-Z0-9]+';
my $tailpat = '[-\w]+';
my %wildcards;
foreach $key (keys(%xmlfields)) {
if (index($key, "*") >= 0) {
my $regex = '^' . $key . '$';
$regex =~ s/\*\$$/$tailpat/;
$regex =~ s/\*/$wordpat/g;
$wildcards{$key} = $regex;
}
}
# Key ordering is lost in a hash.
# Put longer matching wildcard keys before their prefix.
my @wildkeys = reverse(sort(keys(%wildcards)));
foreach $key (keys(%{ $xmlparse->{'attribute'} })) { foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'}; my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
if (!defined($value)) { # Empty string comes from XML as an undef value. if (!defined($value)) { # Empty string comes from XML as an undef value.
$xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = ""; $xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = "";
} }
if ($debug) { print STDERR "User attribute: '$key' -> '$value'\n"
print STDERR "User attribute: '$key' -> '$value'\n"; if ($debug);
my $field = $key;
my $wild;
if (!exists($xmlfields{$key})) {
# Not a regular key; look for a wildcard regex match.
foreach my $wildkey (@wildkeys) {
my $regex = $wildcards{$wildkey};
if ($wild = $key =~ /$regex/) {
$field = $wildkey;
print STDERR "Wildcard: '$key' matches '$wildkey'\n"
if ($debug);
last; # foreach $wildkey
}
}
if (!$wild) {
$errors{$key} = "Unknown attribute";
next; # foreach $key
}
} }
$errors{$key} = "Unknown attribute" my ($dbslot, $required, $default) = @{$xmlfields{$field}};
if (!exists($xmlfields{$key}));
my ($dbslot, $required, $default) = @{$xmlfields{$key}};
if ($required & $SLOT_REQUIRED) { if ($required & $SLOT_REQUIRED) {
# A slot that must be provided, so do not allow a null value. # A slot that must be provided, so do not allow a null value.
...@@ -215,7 +255,7 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) { ...@@ -215,7 +255,7 @@ foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
next; next;
} }
$editsitevars_args{$dbslot} = $value; $editsitevars_args{$key} = $value;
} }
UserError() UserError()
if (keys(%errors)); if (keys(%errors));
......
...@@ -152,6 +152,7 @@ my %xmlfields = ...@@ -152,6 +152,7 @@ my %xmlfields =
"w_password2" => ["w_password2", $SLOT_OPTIONAL], "w_password2" => ["w_password2", $SLOT_OPTIONAL],
"user_interface" => ["user_interface", $SLOT_OPTIONAL], "user_interface" => ["user_interface", $SLOT_OPTIONAL],
"notes" => ["notes", $SLOT_OPTIONAL]); "notes" => ["notes", $SLOT_OPTIONAL]);
# #
# Must wrap the parser in eval since it exits on error. # Must wrap the parser in eval since it exits on error.
# #
...@@ -172,7 +173,8 @@ my %errors = (); ...@@ -172,7 +173,8 @@ my %errors = ();
# #
# Make sure all the required arguments were provided. # Make sure all the required arguments were provided.
# #
foreach my $key (keys(%xmlfields)) { my $key;
foreach $key (keys(%xmlfields)) {
my (undef, $required, undef) = @{$xmlfields{$key}}; my (undef, $required, undef) = @{$xmlfields{$key}};
$errors{$key} = "Required value not provided" $errors{$key} = "Required value not provided"
...@@ -188,20 +190,60 @@ UserError() ...@@ -188,20 +190,60 @@ UserError()
# #
my %moduserinfo_args = (); my %moduserinfo_args = ();
foreach my $key (keys(%{ $xmlparse->{'attribute'} })) { #
# Wildcard keys have one or more *'s in them like simple glob patterns.
# This allows multiple key instances for categories of attributes, and
# putting a "type signature" in the key for arg checking, as well.
#
# Wildcards are made into regex's by anchoring the ends and changing each * to
# a "word" (group of alphahumeric.) A tail * means "the rest", allowing
# multiple words separated by underscores or dashes.
#
my $wordpat = '[a-zA-Z0-9]+';
my $tailpat = '[-\w]+';
my %wildcards;
foreach $key (keys(%xmlfields)) {
if (index($key, "*") >= 0) {
my $regex = '^' . $key . '$';
$regex =~ s/\*\$$/$tailpat/;
$regex =~ s/\*/$wordpat/g;
$wildcards{$key} = $regex;
}
}
# Key ordering is lost in a hash.
# Put longer matching wildcard keys before their prefix.
my @wildkeys = reverse(sort(keys(%wildcards)));
foreach $key (keys(%{ $xmlparse->{'attribute'} })) {
my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'}; my $value = $xmlparse->{'attribute'}->{"$key"}->{'value'};
if (!defined($value)) { # Empty string comes from XML as an undef value. if (!defined($value)) { # Empty string comes from XML as an undef value.
$xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = ""; $xmlparse->{'attribute'}->{"$key"}->{'value'} = $value = "";
} }
if ($debug) { print STDERR "User attribute: '$key' -> '$value'\n"
print STDERR "User attribute: '$key' -> '$value'\n"; if ($debug);
my $field = $key;
my $wild;
if (!exists($xmlfields{$key})) {