1package Sys::Info::Driver::BSD::OS; 2use strict; 3use warnings; 4use vars qw( $VERSION ); 5use base qw( Sys::Info::Base ); 6use POSIX (); 7use Cwd; 8use Carp qw( croak ); 9use Sys::Info::Constants qw( USER_REAL_NAME_FIELD ); 10use Sys::Info::Driver::BSD; 11 12$VERSION = '0.7801'; 13 14my %OSVERSION; 15 16my $MANUFACTURER = { 17 # taken from Wikipedia 18 dragonfly => 'The DragonFly Project', 19 freebsd => 'The FreeBSD Project', 20 openbsd => 'The OpenBSD Project', 21 netbsd => 'The NetBSD Foundation', 22}; 23 24# unimplemented 25sub logon_server {} 26 27sub edition { 28 my $self = shift->_populate_osversion; 29 return $OSVERSION{RAW}->{EDITION}; 30} 31 32sub tz { 33 my $self = shift; 34 return POSIX::strftime('%Z', localtime); 35} 36 37sub meta { 38 my $self = shift; 39 $self->_populate_osversion(); 40 41 require POSIX; 42 require Sys::Info::Device; 43 44 my $cpu = Sys::Info::Device->new('CPU'); 45 my $arch = ($cpu->identify)[0]->{architecture}; 46 my $physmem = fsysctl('hw.physmem'); 47 my $usermem = fsysctl('hw.usermem'); 48 my $swap_call = $^O eq 'openbsd' ? '/sbin/swapctl -l' : '/usr/sbin/swapinfo'; 49 my $swap_buf = qx($swap_call 2>&1); 50 my %swap; 51 if ( $swap_buf ) { 52 foreach my $line ( split m{\n}xms, $swap_buf ) { 53 chomp $line; 54 next if $line =~ m{ \A Device }xms; 55 @swap{ qw/ path size used / } = split m{\s+}xms, $line; 56 last; 57 } 58 } 59 60 my %info; 61 62 $info{manufacturer} = $MANUFACTURER->{ $^O }; 63 $info{build_type} = undef; 64 $info{owner} = undef; 65 $info{organization} = undef; 66 $info{product_id} = undef; 67 $info{install_date} = undef; 68 $info{boot_device} = undef; 69 70 $info{physical_memory_total} = $physmem; 71 $info{physical_memory_available} = $physmem - $usermem; 72 $info{page_file_total} = %swap ? $swap{size} : undef; 73 $info{page_file_available} = %swap ? $swap{size} - $swap{used} : undef; 74 75 # windows specific 76 $info{windows_dir} = undef; 77 $info{system_dir} = undef; 78 79 $info{system_manufacturer} = undef; 80 $info{system_model} = undef; 81 $info{system_type} = sprintf '%s based Computer', $arch; 82 83 $info{page_file_path} = $swap{path}; 84 85 return %info; 86} 87 88sub tick_count { 89 my $self = shift; 90 return time - $self->uptime; 91} 92 93sub name { 94 my($self, @args) = @_; 95 $self->_populate_osversion; 96 my %opt = @args % 2 ? () : @args; 97 my $id = $opt{long} ? ($opt{edition} ? 'LONGNAME_EDITION' : 'LONGNAME') 98 : ($opt{edition} ? 'NAME_EDITION' : 'NAME' ) 99 ; 100 return $OSVERSION{ $id }; 101} 102 103 104sub version { shift->_populate_osversion(); return $OSVERSION{VERSION} } 105sub build { shift->_populate_osversion(); return $OSVERSION{RAW}->{BUILD_DATE} } 106sub uptime { return fsysctl 'kern.boottime' } 107 108# user methods 109sub is_root { 110 my $name = login_name(); 111 my $id = POSIX::geteuid(); 112 my $gid = POSIX::getegid(); 113 return 0 if $@; 114 return 0 if ! defined $id || ! defined $gid; 115 return $id == 0 && $gid == 0; # && $name eq 'root'; # $name is never root! 116} 117 118sub login_name { 119 my($self, @args) = @_; 120 my %opt = @args % 2 ? () : @args; 121 my $login = POSIX::getlogin() || return; 122 my $rv = eval { $opt{real} ? (getpwnam $login)[USER_REAL_NAME_FIELD] : $login }; 123 $rv =~ s{ [,]{3,} \z }{}xms if $opt{real}; 124 return $rv; 125} 126 127sub node_name { return shift->uname->{nodename} } 128 129sub domain_name { } 130 131sub fs { 132 my $self = shift; 133 return unimplemented => 1; 134} 135 136sub bitness { 137 my $self = shift; 138 return; 139} 140 141# ------------------------[ P R I V A T E ]------------------------ # 142 143sub _file_has_substr { 144 my $self = shift; 145 my $file = shift; 146 my $str = shift; 147 return if ! -e $file || ! -f _; 148 my $raw = $self->slurp( $file ) =~ m{$str}xms; 149 return $raw; 150} 151 152sub _probe_edition { 153 my $self = shift; 154 my $name = shift; 155 156 # Check DesktopBSD 157 # /etc/motd 158 # /var/db/pkg/desktopbsd-tools-1.1_2/ 159 return if $name ne 'FreeBSD'; 160 my $dbsd = quotemeta '# $DesktopBSD$'; 161 162 return 'DesktopBSD' if 163 $self->_file_has_substr('/etc/motd' , qr{Welcome \s to \s DesktopBSD}xms ) || 164 $self->_file_has_substr('/etc/devd.conf' , qr{\A $dbsd}xms ) || 165 $self->_file_has_substr('/etc/rc.d/clearmedia', qr{\A $dbsd}xms ); 166 return; # fail! 167} 168 169sub _populate_osversion { 170 return if %OSVERSION; 171 my $self = shift; 172 require POSIX; 173 my($sysname, $nodename, $release, $version, $machine) = POSIX::uname(); 174 175 my(undef, $raw) = split m{\#}xms, $version; 176 my($date, undef) = $raw ? split m{ \s+ \S+ \z }xms, $raw : (undef, undef); 177 my $build_date = $date ? $self->date2time( $date ) : undef; 178 my $build = $date; 179 my $edition = $self->_probe_edition( $sysname ); 180 181 my $kernel = '???'; 182 183 %OSVERSION = ( 184 NAME => $sysname, 185 NAME_EDITION => $edition ? "$sysname ($edition)" : $sysname, 186 LONGNAME => q{}, # will be set below 187 LONGNAME_EDITION => q{}, # will be set below 188 VERSION => $release, 189 KERNEL => undef, 190 RAW => { 191 BUILD => defined $build ? $build : 0, 192 BUILD_DATE => defined $build_date ? $build_date : 0, 193 EDITION => $edition, 194 }, 195 ); 196 197 $OSVERSION{LONGNAME} = sprintf '%s %s (kernel: %s)', 198 @OSVERSION{ qw/ NAME VERSION / }, 199 $kernel; 200 $OSVERSION{LONGNAME_EDITION} = sprintf '%s %s (kernel: %s)', 201 @OSVERSION{ qw/ NAME_EDITION VERSION / }, 202 $kernel; 203 return; 204} 205 2061; 207 208__END__ 209 210=head1 NAME 211 212Sys::Info::Driver::BSD::OS - BSD backend 213 214=head1 SYNOPSIS 215 216- 217 218=head1 DESCRIPTION 219 220This document describes version C<0.7801> of C<Sys::Info::Driver::BSD::OS> 221released on C<12 September 2011>. 222 223- 224 225=head1 METHODS 226 227Please see L<Sys::Info::OS> for definitions of these methods and more. 228 229=head2 build 230 231=head2 domain_name 232 233=head2 edition 234 235=head2 fs 236 237=head2 is_root 238 239=head2 login_name 240 241=head2 logon_server 242 243=head2 meta 244 245=head2 name 246 247=head2 node_name 248 249=head2 tick_count 250 251=head2 tz 252 253=head2 uptime 254 255=head2 version 256 257=head2 bitness 258 259=head1 SEE ALSO 260 261L<Sys::Info>, L<Sys::Info::OS>, 262The C</proc> virtual filesystem: 263L<http://www.redhat.com/docs/manuals/linux/RHL-9-Manual/ref-guide/s1-proc-topfiles.html>. 264 265=head1 AUTHOR 266 267Burak Gursoy <burak@cpan.org>. 268 269=head1 COPYRIGHT 270 271Copyright 2009 - 2011 Burak Gursoy. All rights reserved. 272 273=head1 LICENSE 274 275This library is free software; you can redistribute it and/or modify 276it under the same terms as Perl itself, either Perl version 5.8.8 or, 277at your option, any later version of Perl 5 you may have available. 278 279=cut 280