1. # The Kernel class and its methods, underlying $*KERNEL, are a work in progress.
  2. # It is very hard to capture data about a changing universe in a stable API.
  3. # If you find errors for your hardware or OS distribution, please report them
  4. # with the values that you expected and how to get them in your situation.
  5. class Kernel does Systemic {
  6. has Str $.release;
  7. has Str $!hardware;
  8. has Str $!arch;
  9. has Int $!bits;
  10. sub uname($opt) {
  11. state $has_uname = "/bin/uname".IO.s || "/usr/bin/uname".IO.s;
  12. $has_uname ?? qqx/uname $opt/.chomp !! 'unknown';
  13. }
  14. submethod BUILD(:$!auth = "unknown" --> Nil) { }
  15. method name {
  16. $!name //= do {
  17. given $*DISTRO.name {
  18. when 'mswin32' {
  19. 'win32'
  20. }
  21. default {
  22. lc uname '-s';
  23. }
  24. }
  25. }
  26. }
  27. method version {
  28. $!version //= Version.new( do {
  29. given $*DISTRO.name {
  30. when 'freebsd' {
  31. uname '-r'; # -K -U not introduced until 10.0
  32. }
  33. when 'macosx' {
  34. my $unamev = uname '-v';
  35. $unamev ~~ m/^Darwin \s+ Kernel \s+ Version \s+ (<[\d\.]>+)/
  36. ?? ~$0
  37. !! $unamev.chomp;
  38. }
  39. default {
  40. given $.name {
  41. when 'linux' {
  42. # somewhat counter-intuitively the '-r' is what
  43. # most people think of the kernel version
  44. uname '-r';
  45. }
  46. default {
  47. uname '-v';
  48. }
  49. }
  50. }
  51. }
  52. } );
  53. }
  54. method release {
  55. $!release //= do {
  56. given $*DISTRO.name {
  57. when any <openbsd netbsd dragonfly> { # needs adapting
  58. uname '-r';
  59. }
  60. default {
  61. uname '-v';
  62. }
  63. }
  64. }
  65. }
  66. method hardware {
  67. $!hardware //= do {
  68. given $*DISTRO.name {
  69. default {
  70. uname '-m';
  71. }
  72. }
  73. }
  74. }
  75. method arch {
  76. $!arch //= do {
  77. given $*DISTRO.name {
  78. when 'raspbian' {
  79. uname '-m';
  80. }
  81. default {
  82. uname '-p';
  83. }
  84. }
  85. }
  86. }
  87. method bits {
  88. $!bits //= $.hardware ~~ m/_64|w|amd64/ ?? 64 !! 32; # naive approach
  89. }
  90. has @!signals; # Signal
  91. method signals (Kernel:D:) {
  92. once {
  93. my @names;
  94. if self.name eq 'win32' {
  95. # These are the ones libuv emulates on Windows.
  96. @names = flat "", <INT BREAK HUP WINCH>;
  97. } else {
  98. @names = flat "", qx/kill -l/.words;
  99. @names.splice(1,1) if @names[1] eq "0"; # Ubuntu fudge
  100. @names.=map({.uc}) if $*KERNEL.name eq 'dragonfly';
  101. }
  102. for Signal.^enum_value_list -> $signal {
  103. my $name = substr($signal.key,3);
  104. if @names.first( * eq $name, :k ) -> $index {
  105. @!signals[$index] = $signal;
  106. }
  107. }
  108. }
  109. @!signals
  110. }
  111. has %!signals_by_Str;
  112. proto method signal (|) { * }
  113. multi method signal(Kernel:D: Str:D $signal --> Int:D) {
  114. once {
  115. %!signals_by_Str =
  116. @.signals.pairs.grep(*.value.defined).map({~$_.value => +.key});
  117. }
  118. %!signals_by_Str{$signal} // %!signals_by_Str{"SIG$signal"} // Int;
  119. }
  120. has %!signals_by_Signal;
  121. multi method signal(Kernel:D: Signal:D $signal --> Int:D) {
  122. once {
  123. %!signals_by_Signal =
  124. @.signals.pairs.grep(*.value.defined).map({~$_.value.WHICH => +.key});
  125. }
  126. %!signals_by_Signal{$signal.WHICH} // Int;
  127. }
  128. multi method signal(Kernel:D: Int:D $signal --> Int:D) { $signal }
  129. }
  130. Rakudo::Internals.REGISTER-DYNAMIC: '$*KERNEL', {
  131. PROCESS::<$KERNEL> := Kernel.new;
  132. }