Add the "inspect" command, which provides some quick reference for v1.0.0
authorMahlon E. Smith <mahlon@laika.com>
Tue, 19 Mar 2013 16:35:33 -0700
changeset 51 27bbe75233a3
parent 50 21ba5eb5c2fc
child 52 5de7014b0e60
Add the "inspect" command, which provides some quick reference for server schema objectClasses and attributes.
shelldap
--- a/shelldap	Fri Mar 15 10:02:20 2013 -0700
+++ b/shelldap	Tue Mar 19 16:35:33 2013 -0700
@@ -58,6 +58,8 @@
  - Automatic reconnection attempts if the connection is lost with the
    LDAP server.
 
+ - Basic schema introspection for quick reference.
+
  - It feels like a semi-crippled shell, making LDAP browsing and editing
    at least halfway pleasurable.
 
@@ -92,6 +94,10 @@
     --configfile /tmp/alternate-config.yml
     -f /tmp/alternate-config.yml
 
+This config file overrides values found in the default config, so
+you can easily have separate config files for connecting to your
+cn=monitor or cn=log overlays (for example.)
+
 =back
 
 =over 4
@@ -293,7 +299,7 @@
 
 aliased to: vi
 
-=item B< env>
+=item B<env>
 
  Show values for various runtime variables.
 
@@ -308,6 +314,25 @@
 
  aliased to: search
 
+=item B<inspect>
+
+View schema information about a given entry, or a list of arbitrary
+objectClasses, along with the most common flags for the objectClass
+attributes.
+
+    inspect uid=mahlon
+    inspect posixAccount organizationalUnit
+    inspect _schema
+
+The output is a list of found objectClasses, their schema heirarchy
+(up to 'top'), whether or not they are a structural class, and then
+a merged list of all valid attributes for the given objectClasses.
+Attributes are marked as either required or optional, and whether
+they allow multiple values or not.
+
+If you ask for the special "_schema" object, the raw server schema
+is dumped to screen.
+
 =item B<list>
 
 List entries for the current basedn.  Globbing is supported.
@@ -582,28 +607,18 @@
 	my $self	 = shift;
 	my $use_temp = shift;
 
-	# find the terminal width
-	#
-	my $wrap = $conf->{'wrap'};
-	eval {
-		my $rows;
-		my $term = Term::ReadLine->new( 1 );
-		( $rows, $wrap ) = $term->get_screen_size() unless $wrap;
-	};
-	$wrap ||= 78;
-
 	# create tmpfile and link ldif object with it
 	#
 	if ( $use_temp ) {
 		my ( undef, $fname ) =
 		  File::Temp::tempfile( 'shelldap_XXXXXXXX', DIR => '/tmp', UNLINK => 1 );
-		$self->{'ldif'}	      = Net::LDAP::LDIF->new( $fname, 'w', sort => 1, wrap => $wrap );
+		$self->{'ldif'}	      = Net::LDAP::LDIF->new( $fname, 'w', sort => 1, wrap => $self->wrapsize );
 		$self->{'ldif_fname'} = $fname;
 	}
 
 	# ldif -> stdout
 	else {
-		$self->{'ldif'} = Net::LDAP::LDIF->new( \*STDOUT, 'w', sort => 1, wrap => $wrap );
+		$self->{'ldif'} = Net::LDAP::LDIF->new( \*STDOUT, 'w', sort => 1, wrap => $self->wrapsize );
 	}
 
 	return $self->{'ldif'};
@@ -643,6 +658,24 @@
 }
 
 
+### Find and return the current terminal width.
+###
+sub wrapsize
+{
+	my $self = shift;
+
+	my $wrap = $conf->{'wrap'};
+	eval {
+		my $rows;
+		my $term = Term::ReadLine->new( 1 );
+		( $rows, $wrap ) = $term->get_screen_size() unless $wrap;
+	};
+
+	$wrap ||= 78;
+	return $wrap;
+}
+
+
 ### Used by Term::Shell to generate the prompt.
 ###
 sub prompt_str
@@ -986,9 +1019,7 @@
 sub autocomplete_cwd
 {
 	my $self = shift;
-	my $word = $_[0];
-
-	return sort @{ $self->{'cwd_entries'} };
+	return @{ $self->{'cwd_entries'} };
 }
 
 
@@ -1011,6 +1042,16 @@
 }
 
 
+### Autocomplete values: Returns all objectClasses as defined
+### by the LDAP server, along with current children DNs.
+###
+sub comp_inspect
+{
+	my $self = shift;
+	return ('_schema', @{ $self->{'objectclasses'} }, @{ $self->{'cwd_entries'} });
+}
+
+
 ### Inject various autocomplete and alias routines into the symbol table.
 ###
 {
@@ -1037,8 +1078,8 @@
 		my $sub = "comp_$_";
 		*$sub   = \&autocomplete_cwd;
 	}
-	*comp_touch  = \&comp_create;
-	*comp_export = \&comp_setenv;
+	*comp_touch   = \&comp_create;
+	*comp_export  = \&comp_setenv;
 
 	# setup alias subs
 	#
@@ -1985,6 +2026,114 @@
 }
 
 
+### Show basic information for an entry (DN) or list of objectClasses.
+###
+###   structural/auxillary classes
+###   required attributes
+###   optional attributes
+###
+sub run_inspect
+{
+	my $self = shift;
+	my @ocs  = @_;
+	my $dn   = $ocs[0];
+	my ( $must_attr, $may_attr );
+
+	unless ( $dn ) {
+		print "No DN or objectClass(es) provided.\n";
+		return;
+	}
+
+	# "Magic" argument that dumps all raw schema information.
+	#
+	if ( $dn eq '_schema' ) {
+		$self->{'schema'}->dump();
+		return;
+	}
+
+	# one argument -- if it successfully resolves to a valid DN, fetch
+	# the objectClass list from it.
+	#
+	if ( scalar @ocs == 1 ) {
+		$dn = $self->base() if $dn eq '.';
+		$dn = $self->path_to_dn( $dn );
+
+		my $s = $self->search({ base => $dn, vals => 1, attrs => ['objectClass'] });
+		if ( $s->{'code'} == LDAP_SUCCESS ) {
+			my $e = ${ $s->{'entries'} }[0];
+			@ocs = $e->get_value('objectClass');
+		}
+	}
+
+	# get the complete attributes list.
+	#
+	( $must_attr, $may_attr ) = $self->fetch_attributes( \@ocs );
+	my %must = map { $_ => 1 } @{$must_attr};
+
+	# Output objectClass chains and flags.
+	#
+	print "ObjectClasses:\n";
+	foreach my $oc ( sort @ocs ) {
+		my @sups = $self->findall_supers( $oc );
+
+		my @oc_chain = ( $oc, @sups );
+		my @oc_out;
+
+		foreach my $oc ( @oc_chain ) {
+			my $oc_obj = $self->{'schema'}->objectclass( $oc );
+			next unless $oc_obj;
+
+			$oc = $oc . ' (' . 'structural' . ')' if $oc_obj->{'structural'};
+			push( @oc_out, $oc );
+		}
+
+		print "    " . join( ' --> ', @oc_out ) . "\n" if scalar @oc_out;
+	}
+
+	# Output attributes and flags.
+	#
+	print "\nAttributes:\n";
+	foreach my $attr ( sort (@{$must_attr}, @{$may_attr}) ) {
+		my @flaglist;
+		if ( $self->{'schema'}->attribute( $attr )->{'single-value'} ) {
+			push ( @flaglist, 'single-value' );
+		}
+		else {
+			push ( @flaglist, 'multivalue' );
+		}
+
+		push ( @flaglist, $must{$attr} ? 'required' : 'optional' );
+
+		my $flags = '';
+		$flags = (' (' . join( ', ', sort @flaglist ) . ')') if scalar @flaglist > 0;
+
+		printf( "    %s%s\n", $attr, $flags );
+	}
+
+	print "\n";
+	return;
+}
+
+
+### Recursively walk an objectClass heirarchy, returning an array
+### of inheritence.
+###
+sub findall_supers
+{
+	my $self = shift;
+	my $oc   = shift or return;
+	my @found;
+
+	foreach my $sup ( $self->{'schema'}->superclass($oc) ) {
+		push( @found, $sup );
+		push( @found, $self->findall_supers( $sup ) );
+	}
+
+	return @found;
+}
+
+
+
 ########################################################################
 ### M A I N
 ########################################################################
@@ -1994,7 +2143,7 @@
 use warnings;
 
 $0 = 'shelldap';
-my $VERSION = '0.9.0';
+my $VERSION = '1.0.0';
 
 use Getopt::Long;
 use YAML::Syck;