[Bio] / FigKernelPackages / FIG.pm Repository:
ViewVC logotype

Diff of /FigKernelPackages/FIG.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.9, Mon Dec 22 01:24:22 2003 UTC revision 1.10, Tue Dec 23 22:28:10 2003 UTC
# Line 5  Line 5 
5  use Blast;  use Blast;
6  use FIG_Config;  use FIG_Config;
7    
8    use IO::Socket;
9    
10  use FileHandle;  use FileHandle;
11    
12  use Carp;  use Carp;
# Line 100  Line 102 
102      close(TMP);      close(TMP);
103  }  }
104    
105    sub get_local_hostname {
106        #
107        # First check to see if we our hostname is correct.
108        #
109        # Map it to an IP address, and try to bind to that ip.
110        #
111    
112        my $tcp = getprotobyname('tcp');
113    
114        my $hostname = `hostname`;
115        chop($hostname);
116    
117        my @hostent = gethostbyname($hostname);
118    
119        if (@hostent > 0)
120        {
121            my $sock;
122            my $ip = $hostent[4];
123    
124            socket($sock, PF_INET, SOCK_STREAM, $tcp);
125            if (bind($sock, sockaddr_in(0, $ip)))
126            {
127                #
128                # It worked. Reverse-map back to a hopefully fqdn.
129                #
130    
131                my @rev = gethostbyaddr($ip, AF_INET);
132                if (@rev > 0)
133                {
134                    return $rev[0];
135                }
136                else
137                {
138                    return inet_ntoa($ip);
139                }
140            }
141            else
142            {
143                #
144                # Our hostname must be wrong; we can't bind to the IP
145                # address it maps to.
146                # Return the name associated with the adapter.
147                #
148                return get_hostname_by_adapter()
149            }
150        }
151        else
152        {
153            #
154            # Our hostname isn't known to DNS. This isn't good.
155            # Return the name associated with the adapter.
156            #
157            return get_hostname_by_adapter()
158        }
159    }
160    
161    sub get_hostname_by_adapter {
162        #
163        # Attempt to determine our local hostname based on the
164        # network environment.
165        #
166        # This implementation reads the routing table for the default route.
167        # We then look at the interface config for the interface that holds the default.
168        #
169        #
170        # Linux routing table:
171        # [olson@yips 0.0.0]$ netstat -rn
172        #     Kernel IP routing table
173        #     Destination     Gateway         Genmask         Flags   MSS Window  irtt Iface
174        #     140.221.34.32   0.0.0.0         255.255.255.224 U         0 0          0 eth0
175        #     169.254.0.0     0.0.0.0         255.255.0.0     U         0 0          0 eth0
176        #     127.0.0.0       0.0.0.0         255.0.0.0       U         0 0          0 lo
177        #     0.0.0.0         140.221.34.61   0.0.0.0         UG        0 0          0 eth0
178        #
179        #     Mac routing table:
180        #
181        #     bash-2.05a$ netstat -rn
182        #     Routing tables
183        #
184        #  Internet:
185        #     Destination        Gateway            Flags    Refs      Use  Netif Expire
186        #     default            140.221.11.253     UGSc       12      120    en0
187        #     127.0.0.1          127.0.0.1          UH         16  8415486    lo0
188        #     140.221.8/22       link#4             UCS        12        0    en0
189        #     140.221.8.78       0:6:5b:f:51:c4     UHLW        0      183    en0    408
190        #     140.221.8.191      0:3:93:84:ab:e8    UHLW        0       92    en0    622
191        #     140.221.8.198      0:e0:98:8e:36:e2   UHLW        0        5    en0    691
192        #     140.221.9.6        0:6:5b:f:51:d6     UHLW        1       63    en0   1197
193        #     140.221.10.135     0:d0:59:34:26:34   UHLW        2     2134    en0   1199
194        #     140.221.10.152     0:30:1b:b0:ec:dd   UHLW        1      137    en0   1122
195        #     140.221.10.153     127.0.0.1          UHS         0        0    lo0
196        #     140.221.11.37      0:9:6b:53:4e:4b    UHLW        1      624    en0   1136
197        #     140.221.11.103     0:30:48:22:59:e6   UHLW        3      973    en0   1016
198        #     140.221.11.224     0:a:95:6f:7:10     UHLW        1        1    en0    605
199        #     140.221.11.237     0:1:30:b8:80:c0    UHLW        0        0    en0   1158
200        #     140.221.11.250     0:1:30:3:1:0       UHLW        0        0    en0   1141
201        #     140.221.11.253     0:d0:3:e:70:a      UHLW       13        0    en0   1199
202        #     169.254            link#4             UCS         0        0    en0
203        #
204        #     Internet6:
205        #     Destination                       Gateway                       Flags      Netif Expire
206        #                                                                     UH          lo0
207        #     fe80::%lo0/64                                                   Uc          lo0
208        #                                       link#1                        UHL         lo0
209        #     fe80::%en0/64                     link#4                        UC          en0
210        #     0:a:95:a8:26:68               UHL         lo0
211        #     ff01::/32                                                       U           lo0
212        #     ff02::%lo0/32                                                   UC          lo0
213        #     ff02::%en0/32                     link#4                        UC          en0
214    
215        my($fh);
216    
217        if (!open($fh, "netstat -rn |"))
218        {
219            warn "Cannot run netstat to determine local IP address\n";
220            return "localhost";
221        }
222    
223        my $interface_name;
224    
225        while (<$fh>)
226        {
227            my @cols = split();
228    
229            if ($cols[0] eq "default" || $cols[0] eq "0.0.0.0")
230            {
231                $interface_name = $cols[$#cols];
232            }
233        }
234        close($fh);
235    
236        print "Default route on $interface_name\n";
237    
238        #
239        # Find ifconfig.
240        #
241    
242        my $ifconfig;
243    
244        for my $dir ((split(":", $ENV{PATH}), "/sbin", "/usr/sbin"))
245        {
246            if (-x "$dir/ifconfig")
247            {
248                $ifconfig = "$dir/ifconfig";
249                last;
250            }
251        }
252    
253        if ($ifconfig eq "")
254        {
255            warn "Ifconfig not found\n";
256            return "localhost";
257        }
258        print "Foudn $ifconfig\n";
259    
260        if (!open($fh, "$ifconfig $interface_name |"))
261        {
262            warn "Could not run $ifconfig: $!\n";
263            return "localhost";
264        }
265    
266        my $ip;
267        while (<$fh>)
268        {
269            #
270            # Mac:
271            #         inet 140.221.10.153 netmask 0xfffffc00 broadcast 140.221.11.255
272            # Linux:
273            #           inet addr:140.221.34.37  Bcast:140.221.34.63  Mask:255.255.255.224
274            #
275    
276            chomp;
277            s/^\s*//;
278    
279            print "Have '$_'\n";
280            if (/inet\s+addr:(\d+\.\d+\.\d+\.\d+)\s+/)
281            {
282                #
283                # Linux hit.
284                #
285                $ip = $1;
286                print "Got linux $ip\n";
287                last;
288            }
289            elsif (/inet\s+(\d+\.\d+\.\d+\.\d+)\s+/)
290            {
291                #
292                # Mac hit.
293                #
294                $ip = $1;
295                print "Got mac $ip\n";
296                last;
297            }
298        }
299        close($fh);
300    
301        if ($ip eq "")
302        {
303            warn "Didn't find an IP\n";
304            return "localhost";
305        }
306    
307        return $ip;
308    }
309    
310  sub cgi_url {  sub cgi_url {
311      return &plug_url($FIG_Config::cgi_url);      return &plug_url($FIG_Config::cgi_url);
312  }  }

Legend:
Removed from v.1.9  
changed lines
  Added in v.1.10

MCS Webmaster
ViewVC Help
Powered by ViewVC 1.0.3