Bug #27776 for Filesys-SmbClient: Closing of connections/Use of Multiple connections

I found a similar problem in a long-running daemon that loops, creates an SMB connection, sleeps, and repeats. Each iteration of the loop leaves another TCP connection lingering (viewable using lsof in linux). I have attached a patch that fixes the problem by linking the smbc_free_context C function through XS and calling it from the module's DESTROY method. I have also attached a patch for an additional test script (requiring linux and lsof) to confirm that it works. On Wed Jun 27 05:50:17 2007, danny@debsinc.com wrote: Show quoted text
I've Show quoted text
2 or Show quoted text
can only Show quoted text

diff --git a/SmbClient.pm b/SmbClient.pm index 881ecbe..85a4013 100755 --- a/SmbClient.pm +++ b/SmbClient.pm @@ -383,6 +383,10 @@ sub rmdir_recurse { return $self->rmdir($url); } +sub DESTROY { + my $self=shift; + _free_context($self->{context}, 1); +} 1; diff --git a/SmbClient.xs b/SmbClient.xs index e679f83..b280fc7 100755 --- a/SmbClient.xs +++ b/SmbClient.xs @@ -515,3 +515,21 @@ OUTPUT: RETVAL +int +_free_context(context, shutdown) + SMBCCTX *context + int shutdown +CODE: +/* + * Attempt to delete a context and cleanup its connections. + * if shutdown is 1 cleanup is forced even if connections are busy. + */ + RETVAL = smbc_free_context(context, shutdown); +#ifdef VERBOSE + if (RETVAL != 0) + fprintf(stderr, "*** Error Filesys::SmbClient *** " + "Failed to free context %s, %u\n", + strerror(errno), errno); +#endif +OUTPUT: + RETVAL

diff --git a/t/free_context.t b/t/free_context.t new file mode 100644 index 0000000..596435f --- /dev/null +++ b/t/free_context.t @@ -0,0 +1,57 @@ +#!/usr/bin/perl -w + +use Test::More; +use Filesys::SmbClient; +use strict; +use diagnostics; + +(lc $^O eq 'linux' && system("lsof -v > /dev/null 2>&1") == 0) + or plan skip_all => 'Linux and lsof required to test connection cleanup.'; + +my $loops = 3; +my $tests = $loops * 2; + +plan tests => $tests; + +SKIP: { + # copied from t/02tie.t + skip "No server defined for test at perl Makefile.PL", $tests if (!-e ".c"); + my $ok = 0; + my (%param,$server); + if (open(F,".c")) { + my $l = <F>; chomp($l); + my @l = split(/\t/, $l); + %param = + ( + username => $l[3], + password => $l[4], + workgroup => $l[2], + debug => 0 + ); + $server = "smb://$l[0]/$l[1]"; + } + + for( 1 .. $loops ){ + { + my $smb = Filesys::SmbClient->new(%param); + + my $dh = $smb->opendir($server) + or die $!; + + #is($smb->readdir($dh), '.', 'directory contains "."'); + + is(scalar lsof(), 1, 'one connection open'); + } + # $smb gone out of scope; should clean up its connections + # might need to sleep 1; + + is(scalar lsof(), 0, 'connections removed'); + } +} + +sub lsof { + my @lsof = + grep { /:445 / } # netbios + qx{lsof -P -p $$}; + return @lsof; +}