811 } |
810 } |
812 |
811 |
813 |
812 |
814 # check whether a given string may be a filter |
813 # check whether a given string may be a filter |
815 # Synopsis: $yesNo = $self->is_valid_filter($string); |
814 # Synopsis: $yesNo = $self->is_valid_filter($string); |
|
815 # |
816 sub is_valid_filter |
816 sub is_valid_filter |
817 { |
817 { |
818 my $self = shift; |
818 my $self = shift; |
819 my $filter = shift or return; |
819 my $filter = shift or return; |
820 my $filterObject = Net::LDAP::Filter->new($filter); |
820 |
821 |
821 return Net::LDAP::Filter->new( $filter ) ? 1 : 0; |
822 return $filterObject ? 1 : 0 |
822 } |
823 } |
823 |
824 |
824 |
825 # little. yellow. different. better. |
825 # little. yellow. different. better. |
826 # |
826 # |
827 sub debug |
827 sub debug |
828 { |
828 { |
1427 ); |
1427 ); |
1428 } |
1428 } |
1429 |
1429 |
1430 sub run_list |
1430 sub run_list |
1431 { |
1431 { |
1432 my $self = shift; |
1432 my $self = shift; |
1433 my @args = @_; |
1433 my @args = @_; |
1434 my $base = $self->base(); |
|
1435 my @attrs = (); |
1434 my @attrs = (); |
1436 my $flags = ''; |
1435 my $filter; |
1437 my $filter = '(objectclass=*)'; |
1436 |
|
1437 # flag booleans |
|
1438 my ( $recurse, $long ); |
1438 |
1439 |
1439 # parse arguments: [ <option> ...] [<filter> ...] [<attribute> ...] |
1440 # parse arguments: [ <option> ...] [<filter> ...] [<attribute> ...] |
1440 if (@args) { |
1441 if ( scalar @args ) { |
1441 # options: support '-l' or '-R' listings |
1442 # options: support '-l' or '-R' listings |
1442 if ( $args[0] =~ /^\-([lR])/o ) { |
1443 if ( $args[0] =~ /^\-(\w+)/o ) { |
1443 $flags .= $1; |
1444 my $flags = $1; |
1444 shift(@args); |
1445 $recurse = $flags =~ /R/; |
|
1446 $long = $flags =~ /l/; |
|
1447 shift( @args ); |
1445 } |
1448 } |
1446 |
1449 |
1447 my @filters; |
1450 my @filters; |
1448 |
1451 |
1449 # get filter elements from argument list |
1452 # get filter elements from argument list |
1450 while (@args && $self->is_valid_filter($args[0])) { |
1453 while ( @args && $self->is_valid_filter($args[0]) ) { |
1451 push(@filters, shift(@args)); |
1454 push( @filters, shift(@args) ); |
1452 } |
1455 } |
1453 |
1456 |
1454 push(@filters, '(objectclass=*)') if (!@filters); |
1457 push( @filters, '(objectClass=*)' ) unless scalar @filters; |
1455 |
1458 |
1456 # construct OR'ed filter from filter elements |
1459 # construct OR'ed filter from filter elements |
1457 $filter = $self->make_filter( \@filters ); |
1460 $filter = $self->make_filter( \@filters ); |
1458 |
1461 |
1459 # remaining arguments must be attributes |
1462 # remaining arguments must be attributes |
1460 push(@attrs, @args); |
1463 push( @attrs, @args ); |
1461 } |
1464 } |
1462 |
1465 |
1463 # flag booleans |
1466 # Get all attributes if none are specified, and we're in long-list mode. |
1464 my ( $recurse, $long ); |
1467 push( @attrs, '*' ) if $long && ! scalar @attrs; |
1465 if ( $flags ) { |
|
1466 $recurse = $flags =~ /R/o; |
|
1467 $long = $flags =~ /l/o; |
|
1468 push(@attrs, '*') if ($long && !@attrs); |
|
1469 } |
|
1470 |
1468 |
1471 my $s = $self->search({ |
1469 my $s = $self->search({ |
1472 scope => $recurse ? 'sub' : 'one', |
1470 scope => $recurse ? 'sub' : 'one', |
1473 vals => 1, |
1471 vals => 1, |
1474 filter => $filter, |
1472 filter => $filter, |
1494 }; |
1492 }; |
1495 |
1493 |
1496 # iterate and print |
1494 # iterate and print |
1497 # |
1495 # |
1498 my $dn_count = 0; |
1496 my $dn_count = 0; |
|
1497 my $base = $self->base(); |
1499 foreach my $e ( sort { $a->dn() cmp $b->dn() } @{ $s->{'entries'} } ) { |
1498 foreach my $e ( sort { $a->dn() cmp $b->dn() } @{ $s->{'entries'} } ) { |
1500 my $dn = $e->dn(); |
1499 my $dn = $e->dn(); |
1501 |
1500 next if lc( $dn ) eq lc( $base ); |
1502 # only show RDN unless -l was given |
1501 |
1503 $dn = canonical_dn([shift(@{ldap_explode_dn($dn, casefold => 'none')})], |
1502 if ( ! $long ) { |
1504 casefold => 'none') |
1503 # strip the current base from the dn, if we're recursing and not in long mode |
1505 unless ($long); |
1504 if ( $recurse ) { |
|
1505 $dn =~ s/,$base//oi; |
|
1506 } |
|
1507 |
|
1508 # only show RDN unless -l was given |
|
1509 else { |
|
1510 $dn = canonical_dn( [shift(@{ldap_explode_dn($dn, casefold => 'none')})], casefold => 'none' ) |
|
1511 } |
|
1512 } |
1506 |
1513 |
1507 # if this entry is a container for other entries, append a |
1514 # if this entry is a container for other entries, append a |
1508 # trailing slash. |
1515 # trailing slash. |
1509 $dn .= '/' if ($e->get_value('hasSubordinates') eq 'TRUE'); |
1516 $dn .= '/' if ($e->get_value('hasSubordinates') eq 'TRUE'); |
1510 |
1517 |
1511 # additional arguments given; show their values |
1518 # additional arguments/attributes were given; show their values |
1512 if (@args) { |
1519 # |
|
1520 if ( scalar @args ) { |
1513 my @elements = ( $dn ); |
1521 my @elements = ( $dn ); |
1514 |
1522 |
1515 foreach my $attr (@args) { |
1523 foreach my $attr ( @args ) { |
1516 my @vals = $e->get_value($attr); |
1524 my @vals = $e->get_value( $attr ); |
1517 push(@elements, join(',', @vals)); |
1525 push( @elements, join(',', @vals) ); |
1518 } |
1526 } |
1519 |
1527 |
1520 print join("\t", @elements)."\n"; |
1528 print join( "\t", @elements )."\n"; |
1521 } |
1529 } |
1522 else { |
1530 else { |
1523 # show descriptions |
1531 # show descriptions |
1524 my $desc = $e->get_value('description'); |
1532 my $desc = $e->get_value( 'description' ); |
1525 if ( $desc ) { |
1533 if ( $desc ) { |
1526 $desc =~ s/\n.*//s; # 1st line only |
1534 $desc =~ s/\n.*//s; # 1st line only |
1527 $dn .= " ($desc)"; |
1535 $dn .= " ($desc)"; |
1528 } |
1536 } |
1529 |
1537 |
1530 # no desc? Try and infer something useful |
1538 # no desc? Try and infer something useful |
1531 # to display. |
1539 # to display. |
1532 else { |
1540 else { |
1533 |
1541 |
1534 # pull objectClasses, hash for lookup speed |
1542 # pull objectClasses, hash for lookup speed |
1535 my @oc = $e->get_value('objectClass'); |
1543 my @oc = $e->get_value( 'objectClass' ); |
1536 my %ochash; |
1544 my %ochash; |
1537 map { $ochash{$_} = 1 } @oc; |
1545 map { $ochash{$_} = 1 } @oc; |
1538 |
1546 |
1539 foreach my $d_listing ( sort keys %descs ) { |
1547 foreach my $d_listing ( sort keys %descs ) { |
1540 if ( exists $ochash{ $d_listing } ) { |
1548 if ( exists $ochash{ $d_listing } ) { |