API tools faq
paste
Advertisement
Guest User

Untitled

a guest
Jun 16th, 2011
114
0
Never
Add comment
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
TCL 17.23 KB | None | 0 0
raw download clone embed print report
  1. #!/bin/sh
  2. # Start Tcl \
  3. exec tclsh $0 $@
  4.  
  5. # Copyright 2006 Brian Ronald.  All rights reserved.
  6. # Autopilot for use on OpenTTD dedicated server console.
  7. #
  8. # This program is free software; you can redistribute it and/or
  9. # modify it under the terms of the GNU General Public License
  10. # as published by the Free Software Foundation; either version 2
  11. # of the License, or (at your option) any later version.
  12. #
  13. # This program is distributed in the hope that it will be useful,
  14. # but WITHOUT ANY WARRANTY; without even the implied warranty of
  15. # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  16. # GNU General Public License for more details.
  17. #
  18. # You should have received a copy of the GNU General Public License
  19. # along with this program; if not, write to the Free Software
  20. # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  21.  
  22. # sanity check - do not run as root
  23. if {$tcl_platform(user) == "root"} {
  24.     puts {WARNING}
  25.     puts {please do not run ap+ as user 'root'}
  26.     exit 1
  27. }
  28.  
  29. # sanity check - require tcl 8.4
  30. if {[package vcompare [info tclversion] 8.4] < 0} {
  31.     puts {WARNING}
  32.     puts "ap+ requires at least tcl version 8.4"
  33.     puts "You are trying to use tcl [info patchlevel]"
  34.     exit 1
  35. }
  36.  
  37. # sanity check - require unix platform
  38. if {$tcl_platform(platform) != {unix}} {
  39.     puts {WARNING}
  40.     puts "ap+ does not support your operating system ($tcl_platform(platform))"
  41.     exit 1
  42. }
  43.  
  44. package require msgcat
  45. package require Expect
  46. log_user 0
  47.  
  48. set pidfile autopilot.pid
  49. exec echo [ pid ] > $pidfile
  50.  
  51. # Decide which config file we're using; either set by environment, or default.
  52. set inifilename openttd.cfg
  53. if [info exists env(OTTD_CONFIG)] {
  54.     set inifilename $env(OTTD_CONFIG)
  55. }
  56.  
  57. namespace eval mainloop {
  58.     # Do nothing; just make the namespace
  59. }
  60.  
  61. # Fetch in our library of functions
  62. source autopilot/libs/main.tcl
  63.  
  64. # Read in values from openttd.cfg
  65. # namespace apconfig contains only configuration lists
  66. ::ap::config::load $inifilename
  67.  
  68. # load language definitions
  69. ::msgcat::mclocale [::ap::config::getLanguage en]
  70. ::msgcat::mcload autopilot/lang
  71.  
  72. # Our version - if you modify and redistribute, please change this
  73. # string to reflect the fact that this autopilot isn't the original
  74. # autopilot by Brian Ronald.
  75. set version [::ap::func::getApVersion]
  76.  
  77. if {![info exists ::ap::config::autopilot]} {
  78.     error [::msgcat::mc dbg_autopilot_no_config $inifilename]
  79.     exit 1
  80. }
  81.  
  82. # Check the config, and include support for extra features
  83. if {[::ap::config::isEnabled autopilot use_irc]} {
  84.     source autopilot/libs/irc.tcl
  85. }
  86.  
  87. if {[::ap::config::isEnabled autopilot use_mysql]} {
  88.     source autopilot/libs/mysql.tcl
  89. }
  90.  
  91. if {[::ap::config::isEnabled autopilot use_signals]} {
  92.     source autopilot/libs/signals.tcl
  93. }
  94.  
  95. # Three ways to start the game - new, load default, load specified
  96. # Construct the command we plan to spawn.
  97.  
  98. if {[set openttd [::ap::config::get autopilot command]] == {} } {
  99.     set openttd {./openttd}
  100. }
  101.  
  102. ::ap::game::output [::msgcat::mc autopilot_engaged]
  103. set arg1 [ lindex $argv 0 ]
  104. set arg2 [ lindex $argv 1 ]
  105. if { [ string equal "$arg1" "load" ] } {
  106.     if { [ string length $arg2 ] > 0 } {
  107.         set commandline "$openttd -c $inifilename -D -g $arg2 [::ap::config::get autopilot command_endargs]"
  108.         ::ap::game::output [::msgcat::mc game_start_save [::ap::config::get network server_name]]
  109.     } else {
  110.         set commandline "$openttd -c $inifilename -D -g save/game.sav [::ap::config::get autopilot command_endargs]"
  111.         ::ap::game::output [::msgcat::mc game_start_default [::ap::config::get network server_name]]
  112.     }
  113. } else {
  114.     set commandline "$openttd -c $inifilename -D [::ap::config::get autopilot command_endargs]"
  115.     ::ap::game::output [::msgcat::mc game_start_new [::ap::config::get network server_name]]
  116.     ::ap::game::output [::msgcat::mc game_spec_landscape [::ap::config::get game_creation landscape]]
  117.     if {[::ap::config::get game_creation map_y] != {}} {
  118.         ::ap::game::output [::msgcat::mc game_spec_dimensions [expr (pow(2,[::ap::config::get game_creation map_y]))] [expr (pow(2,[::ap::config::get game_creation map_x]))]]
  119.     } else {
  120.         ::ap::game::output [::msgcat::mc game_spec_dimensions [expr (pow(2,[::ap::config::get patches map_y]))] [expr (pow(2,[::ap::config::get patches map_x]))]]
  121.     }
  122.     if {[::ap::config::get game_creation starting_year] != {}} {
  123.         ::ap::game::output [::msgcat::mc game_spec_start_year [::ap::config::get game_creation starting_year]]
  124.     } else {
  125.         if {[::ap::config::get patches starting_year] != {}} {
  126.             ::ap::game::output [::msgcat::mc game_spec_start_year [::ap::config::get patches starting_year]]
  127.         } else {
  128.             ::ap::game::output [::msgcat::mc game_spec_start_year [::ap::config::get patches starting_date]]
  129.         }
  130.     }
  131.  
  132.     if {[namespace exists ::mod_db]} {
  133.         ::mod_db::newgame [::ap::config::get network server_name]
  134.     }
  135. }
  136.  
  137. # Get the version
  138. set ottd_version [::ap::game::version $openttd]
  139.  
  140. # Start openttd in dedicated mode
  141. set ds [::ap::game::start $commandline]
  142.  
  143. set ::pause_level [::ap::config::get autopilot pause_level]
  144.  
  145. # Create a list of passwords if that feature is enabled, and trigger
  146. # the recurring password randomizer
  147. if {[::ap::config::isEnabled autopilot randomize_password]} {
  148.     if { $::pause_level > 0 } {
  149.         set ::pw_pause $::pause_level
  150.     } else {
  151.         set ::pw_pause [::ap::config::get network min_active_clients]
  152.     }
  153.     set ::players $::pw_pause
  154.     set wordfile [open [::ap::config::get autopilot password_list] "r"]
  155.     set worddata [read -nonewline $wordfile]
  156.     close $wordfile
  157.     set passwords [split $worddata "\n"]
  158.     set numpasswords [llength $passwords]
  159.     ::ap::func::every [::ap::config::get autopilot password_frequency] {
  160.         if { $::players >= $::pw_pause } {
  161.             set ::password [::ap::func::lrandom $::passwords]
  162.             ::ap::game::console "server_pw $::password\r"
  163.             ::ap::callback::execute {} ::ap::game::say 0 [list {[callback] on_game_serverpw} $::password] {autopilot/scripts/callback/} {on_game_serverpw.tcl}
  164.         }
  165.     }
  166. } else {
  167.     set ::password [::ap::config::get network server_password]
  168. }
  169.  
  170. if {[namespace exists ::mod_db]} {
  171.    ::mod_db::set_password $::password
  172. }
  173.  
  174. # Set some expect variables
  175. set spawn_id $ds
  176.  
  177. # Initialize the OpenTTD Console with useful aliases for ap
  178. ::ap::game::initConsole
  179.  
  180. # Send some one-off commands to the server
  181.  
  182. # set the debug level according to the autopilot config setting!
  183. ::ap::game::console "debug_level \"[::ap::config::get autopilot debug_level]\"\r"
  184.  
  185. # only pause a new game if 'pause_on_newgame' is enabled
  186. if {[::ap::config::isEnabled gui pause_on_newgame] || [::ap::config::isEnabled patches pause_on_newgame]} {
  187.     ::ap::game::pause
  188. }
  189.  
  190. # Initialize other variables
  191. set name [::ap::config::get network client_name]
  192. if {[::ap::config::isEnabled autopilot use_console]} {
  193.     set standard_delay [expr ([::ap::config::get autopilot responsiveness] * 1000 + 500)]
  194. } else {
  195.     set standard_delay 1000
  196. }
  197.  
  198. # Getting started by sending a couple of commands and reading the output.
  199. # We want to know the maximum number of companies, players and spectators,
  200. # and details of which companies already exist, if any.
  201.  
  202. ::ap::game::console "server_info\r"
  203.  
  204. # I *really* want these variables setting.
  205. set timeout 3600
  206.  
  207. expect {
  208.     -re "Current/maximum clients: *\[ 0-9\]*/\[ 0-9\]{2}" {
  209.         scan $expect_out(0,string) "Current/maximum clients:    %2d/%2d" players max_clients
  210.         exp_continue
  211.     }
  212.     -re "Current/maximum companies: *\[ 0-9\]*/\[ 0-9\]{2}" {
  213.         scan $expect_out(0,string) "Current/maximum companies:  %2d/%2d" companies max_companies
  214.         exp_continue
  215.     }
  216.     -re "Current/maximum spectators: *\[ 0-9\]*/\[ 0-9\]{2}" {
  217.         scan $expect_out(0,string) "Current/maximum spectators: %2d/%2d" - max_spectators
  218.     }
  219. }
  220.  
  221. # Now set the timeout for the main loop's expect
  222. set timeout [::ap::config::get autopilot responsiveness]
  223.  
  224. # This is it - the main Expect loop.  Wrapped in a namespace
  225. # to avoid accidental pollution.  It's monolithic, and
  226. # unashamedly so.
  227.  
  228. namespace eval mainloop {
  229.  
  230.     # Array for players
  231.     array set player {}
  232.  
  233.     # map player names to id's
  234.     array set nick2id {}
  235.  
  236.     # company array
  237.     array set company {}
  238.  
  239.     # Whether to enable the console for commands
  240.     set use_console [::ap::config::get autopilot use_console]
  241.     if $use_console {log_user 1}
  242.  
  243.     # Start a background periodic task to recount players and
  244.     # companies - just in case the game "forgets" to inform us
  245.     # and we lose count, only needed when ap controls pause.
  246.     if { $::pause_level >= 0 } {
  247.         ::ap::func::every [::ap::config::get autopilot recount_frequency] ::ap::count::players
  248.     } else {
  249.         ::ap::count::players
  250.     }
  251.    
  252.     while true {
  253.         expect {
  254.             -re ".*\n" {
  255.                 # This is a greedy regex, so it might *contain* more \n
  256.                 set out_buffer $expect_out(0,string)
  257.                 # The regex matches one or more lines.  Separate them.
  258.                 foreach linestr [split [string map {"\r" {} } $out_buffer] "\n"] {
  259.                     # You'll get at least one empty from the split
  260.                     if {$linestr != {} } {
  261.                         regexp -nocase {^(\[\d\d\d\d-\d\d-\d\d \d\d:\d\d:\d\d\])\s+(.*)} $linestr line timestamp linestr
  262.                         set line [split $linestr]
  263.                         # Get this far, and we have exactly one line of output from the server.
  264.                         # Now we have fun with ifs and cases!
  265.                         if {[string first {dbg: } $linestr] == 0} {
  266.                             # this is debug output, just output the info to the console
  267.                             puts $linestr
  268.                         } elseif {[string first {openttd: } $linestr] == 0 && [::ap::config::isEnabled autopilot catch_assert]} {
  269.                             # this looks like an assertion... just make sure it is one
  270.                             if {[string first {Assertion} $linestr] > -1} {
  271.                                 # output it to irc, as the app will soon die
  272.                                 ::ap::say::fromGame [string replace $linestr [string first {/} $linestr] [string first {/src/} $linestr]]
  273.                             }
  274.                         } elseif {[string first {[All] } $linestr] == 1 || [string first {[Private] } $linestr] == 1} {
  275.                             set chat [regexp -inline -- {\[(All|Private)\] (.+?): (.*)} $linestr]
  276.  
  277.                             set nick [lindex $chat 2]
  278.                             set lineafternick [lindex $chat 3]
  279.  
  280.                             set private 0
  281.  
  282.                             if {[lindex $chat 1] == "Private"} {
  283.                                 set private 1
  284.                             }
  285.  
  286.                             if {$nick == $::name} {
  287.                                 # dont handle what we ourselves say!
  288.                             } elseif {$private && [::ap::func::getClientId $nick] == 0} {
  289.                                 # if we say in private To somebody, the cought nick is prefixed with "To " and we get a 0 back as Id
  290.                                 # ignore commands the server might say in private
  291.                             } elseif {[string first {!} $lineafternick] == 0} {
  292.                                 # this is a bang_command...
  293.                                 set bang_command [split [string range $lineafternick 1 end]]
  294.                                 switch -- $bang_command {
  295.                                     {version} {
  296.                                         ap::game::say::reply $private $nick $::version
  297.                                     }
  298.                                     {default} {
  299.                                         variable filename "[lindex $bang_command 0].tcl"
  300.  
  301.                                         if {![::ap::callback::execute $nick ::ap::game::say $private [lrange $bang_command 0 end] {autopilot/scripts/game/} "$filename"]} {
  302.                                             if {![::ap::callback::execute $nick ::ap::game::say $private [lrange $bang_command 0 end] {autopilot/scripts/global/} "$filename"]} {
  303.                                                 ::ap::debug [namespace current] [::msgcat::mc dbg_callback_not_found [lindex $bang_command 0]]
  304.                                             }
  305.                                         }
  306.                                     }
  307.                                 }
  308.                             } elseif {!$private} {
  309.                                 if {[string first {/me } $lineafternick] == 0} {
  310.                                     ::ap::say::fromGame "* $nick [lrange $lineafternick 1 end]"
  311.                                 } else {
  312.                                     ::ap::say::fromGame "<$nick> $lineafternick"
  313.                                 }
  314.                             }
  315.                         } elseif {[string first "Company Name" $linestr] > 1} {
  316.                             # Output from players command, populate companies
  317.                             # First pull out the name, which can contain quotes
  318.                             set c_name [join [lrange [split $linestr '] 1 end-1] ']
  319.                             set ncline [string map "{'$c_name'} discarded" $linestr]
  320.                             # then scan everything else, which is far more predictable
  321.                             scan $ncline "#:%d(%\[^)\]) Company Name: discarded  Year Founded: %d  Money: %d  Loan: %d  Value: %d  (T:%\[^,\], R:%\[^,\], P:%\[^,\], S:%\[^,)])" c_number c_color c_founded c_money c_loan c_value c_trains c_roadvehicles c_planes c_ships
  322.                             set company($c_number) "{$c_color} {$c_name} $c_founded $c_money $c_loan $c_value $c_trains $c_roadvehicles $c_planes $c_ships"
  323.                         }
  324.                         if {[string first "*** " $linestr] == 1} {
  325.                             # Somebody joined, left or was renamed, or company changes occured
  326.                             switch -regexp -- $linestr {
  327.                                 {\*{3} .* has joined the game .*$} {
  328.                                     # Joined the game.  Greet, announce and increment count.
  329.                                     set nick [lrange [split $linestr] 1 end-6]
  330.  
  331.                                     # We used to increment and decrement, but this also
  332.                                     # populates the player array.
  333.                                     ::ap::count::players
  334.  
  335.                                     after $::standard_delay [string map "NICK {$nick}" {::ap::callback::execute {NICK} ::ap::game::say 1 [list {[callback] on_game_join}] {autopilot/scripts/callback/} {on_game_join.tcl}}]
  336.  
  337.                                     # Unpause if there are enough players.
  338.                                     if {[::ap::config::isEnabled autopilot save_on_join]} {
  339.                                         ::ap::game::save "join_[format %x [clock seconds]]"
  340.                                     }
  341.                                     if {$::players > $::pause_level && $::pause_level >= 0} {
  342.                                         ::ap::game::unpause
  343.                                     }
  344.                                 }
  345.                                 {\*{3} .* has left the game .*$} {
  346.                                     # Left the game.  Announce and decrement count.
  347.                                     ::ap::say::fromGame "*** [join [lrange $line 1 end]]"
  348.                                     # We used to increment and decrement, but this also
  349.                                     # populates the player array.
  350.                                     ::ap::count::players
  351.                                     # Pause if there are too few players.
  352.                                     if {$::players <= $::pause_level && $::pause_level >= 0} {
  353.                                         ::ap::game::pause
  354.                                         ::ap::game::save
  355.                                     }
  356.                                 }
  357.                                 {\*{3} .* has changed his/her name to .*$} -
  358.                                 {\*{3} .* has joined (:?company #\d+|spectators)$} -
  359.                                 {\*{3} .* has started a new company .*$} -
  360.                                                                 {\*{3} Game (un)*paused \(manual\)$} -
  361.                                                                 {\*{3} Game (un)*paused \(number of players\)$} -
  362.                                                                 {\*{3} Game still paused \((manual, )*number of players\)$} -
  363.                                 {\*{3} Game (un)*paused \((not )*enough players\)$} {
  364.                                     ::ap::say::fromGame "*** [lrange $line 1 end]"
  365.                                     ::ap::count::players
  366.                                 }
  367.                             }
  368.                         }
  369.                         if {[string first "Current/maximum companies: " $linestr] == 0} {
  370.                             scan $linestr "Current/maximum companies:  %2d/%2d" ::companies ::max_companies
  371.                         }
  372.                         if {[string first "'rcon_pw' changed to:  " $linestr] == 0} {
  373.                             set newentry "rcon_password [lindex $line 4]"
  374.                             set location [lsearch [set ::ap::config::network] rcon_password*]
  375.                             set ::ap::config::network "[lreplace [set ::ap::config::network] $location $location $newentry]"
  376.                         }
  377.                         if {[string first "'server_pw' changed to:  " $linestr] == 0} {
  378.                             set ::password [lindex $line 4]
  379.                             if {[namespace exists ::mod_db]} {
  380.                                ::mod_db::set_password $::password
  381.                             }
  382.                         }
  383.                         if {[regexp "^Client.*unique-id: '\[0-9,a-f\]*'\$" $linestr]} {
  384.                             # We're discarding output from status
  385.                         } elseif {[string first "Client" $linestr] == 0} {
  386.                             # Output from clients command, populate players
  387.                             # First pull out the name, which can contain quotes
  388.                             set p_name [join [lrange [split $linestr '] 1 end-1] ']
  389.                             set npline [string map "{'$p_name'} discarded" $linestr]
  390.                             # then scan everything else, which is far more predictable
  391.                             scan $npline "Client #%d  name: discarded  company: %d  IP: %s" p_number p_company p_IP
  392.                             # Ignore client #1 (the server)
  393.                             if {$p_number > 1} {
  394.                                 set pl_number [array size player]
  395.                                 set nick2id($p_name) $p_number
  396.                                 if {$p_company > $::max_companies} {
  397.                                     set player([expr $pl_number + 1]) "{$p_name} $p_company $p_IP {[lindex $company(255) 0]} $p_number"
  398.                                 } else {
  399.                                     set player([expr $pl_number + 1]) "{$p_name} $p_company $p_IP {[lindex $company($p_company) 0]} $p_number"
  400.                                 }
  401.                             }
  402.                         }
  403.                         if {[string match doneclientcount $linestr]} {
  404.                             set ::players [array size player]
  405.                         }
  406.                         if {[string first {Map sucessfully saved to} $linestr] == 0} {
  407.                             ::ap::say::everywhere [::msgcat::mc game_saved]
  408.                         }
  409.                     }
  410.                 }
  411.             }
  412.             eof {
  413.                 # wait for the client process to quit
  414.                 exp_wait
  415.  
  416.                 ::ap::game::output [::msgcat::mc game_quit_message]
  417.  
  418.                 if {[namespace exists ::mod_db]} {
  419.                     ::mod_db::network::quit [::msgcat::mc game_quit_by_admin]
  420.                 }
  421.  
  422.                 exec echo {} > $pidfile
  423.                 break;
  424.             }
  425.         }
  426.         # Respond to player commands from console, if enabled
  427.         if $use_console {
  428.             expect_user {
  429.                 "quit\n" {
  430.                     ::ap::say::everywhere [::msgcat::mc game_quit_by_admin]
  431.                     ::ap::game::quit
  432.                 }
  433.                 "exit\n" {
  434.                     ::ap::say::everywhere [::msgcat::mc game_quit_by_admin]
  435.                     ::ap::say::everywhere [::msgcat::mc game_saving]
  436.                     ::ap::game::save
  437.                     ::ap::game::quit
  438.                 }
  439.                 "save\n" {
  440.                     ::ap::say::everywhere [::msgcat::mc game_saving]
  441.                     ::ap::game::save
  442.                 }
  443.                 "version\n" {
  444.                     puts $::version
  445.                 }
  446.                 "license\n" {
  447.                     puts [::msgcat::mc autopilot_license]
  448.                 }
  449.                 -re "(.*)\n" {
  450.                     ::ap::game::console "$expect_out(1,string)\r"
  451.                 }
  452.             }
  453.         }
  454.     }
  455.  
  456.     # End of ::mainloop namespace
  457. }
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement
Public Pastes
Advertisement
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.  OK, I Understand
Not a member of Pastebin yet?
Sign Up, it unlocks many cool features!